Macro Excel - Copia dati ogni 300 righe

Question

Ciao a tutti,

ho la necessità di copiare da una cartella di lavoro ad un'altra, un range di celle per ogni 300 righe fino a fine file che è variabile.

Conviene un ciclo for next che mi crea ogni volta il range variabile o esiste un modo diverso con poche istruzioni ?

Grazie

Answer 1

Ciao IL CREM,

avrai notato che l'ultimo file comprende le righe vuote fino alla trecentesima dell'ultimo blocco. Se vuoi evitarlo sostituisci:

          Print #ff, strRow

con:

          If Len(Trim$(Replace(strRow, vbTab, ""))) Then

            Print #ff, strRow

          End If

Answer 2

Ciao IL CREM,

un txt? Prima avevi detto da una cartella di lavoro ad un'altra.

Per il txt un modo è questo:

Public Sub Test()

On Error GoTo ExtP

' ---------- PERSONALIZZARE ---------- >

'

Const cstrPath    As String = "D:\Percorso\IL CREM"

Const cstrFilePfx As String = "TEST"

Const cstrFileExt As String = "TXT"

Const cstrWsh     As String = "Foglio1"

Const cstrRng     As String = "A1"

Const clngStep    As Long = 300

Const clngCols    As Long = 3

'

' ---------- PERSONALIZZARE ---------- <

Dim wbk As Excel.Workbook

Dim wsh As Excel.Worksheet

Dim rng As Excel.Range

Dim lngRow      As Long

Dim lngOffset   As Long

Dim avntRng     As Variant

Dim intSfx      As Integer

Dim strFullname As String

Dim ff          As Integer

Dim intDim1     As Integer

Dim intDim2     As Integer

Dim strRow      As String

    Set wbk = Application.ThisWorkbook

    Set wsh = wbk.Worksheets(cstrWsh)

    Set rng = wsh.Range(cstrRng)

    With wsh

      For lngRow = rng.Row - 1 To .Rows.Count - 1 Step clngStep

        If IsEmpty(rng.Offset(lngOffset).Value) Then Exit For

        avntRng = .Range(rng.Offset(lngOffset), _

                   rng.Offset(lngOffset + clngStep - 1) _

                   ).Resize(, clngCols).Value

        intSfx = intSfx + 1

        strFullname = cstrPath & cstrFilePfx & _

                      CStr(intSfx) & "." & cstrFileExt

        ff = FreeFile

        Open strFullname For Output As #ff

        For intDim1 = LBound(avntRng, 1) To UBound(avntRng, 1)

          strRow = ""

          For intDim2 = LBound(avntRng, 2) To UBound(avntRng, 2)

            strRow = strRow & vbTab & avntRng(intDim1, intDim2)

          Next

          strRow = Mid$(strRow, 2)

          Print #ff, strRow

        Next

        Close

        lngOffset = lngOffset + clngStep

      Next

    End With

ExtP:

    With Err

      If .Number Then MsgBox .Description

    End With

    On Error Resume Next

    Close

    Set rng = Nothing

    Set wsh = Nothing

    Set wbk = Nothing

End Sub

Answer 3

Ciao,

parlavo di txt perchè la mia idea era copiare ogni 300 righe e salvare con nome in txt , però la copia è tra 2 cartelle.

Mentre il tuo codice mi crea direttamente il txt ed è molto meglio.

L'unica cosa che non conosco l'istruzione

rng.Offset(lngOffset).Value

che in effetti è empty e mi esce dal ciclo subito

Ancora grazie mille

Answer 4

Buongiorno Maurizio ,

copia di 300 blocchi e creazione di un txt, poi altri 300 (dalla 301) e creazione del secondo txt , così fino a fine file.

Grazie mille

Answer 5

Ciao IL CREM,

non ho capito: devi copiare blocchi di 300 celle per volta in tanti Fogli di lavoro quanti ne sono necessari oppure una cella ogni 300?