How can i copy excell data from a sheet by parts?

[zabiullakhan]

I want to copy excell data in parts for example 10 rows at a time.

• I need to determin the no of rows present in the sheet1
• Copy 10 rows at a time from sheet1 and past into sheet2 (using a loop)

Note : I cant copy the whole data at once as per the requirment.

Please help.

 

[Sektor]

ElseIf IsEmpty(Cells(i + 1, 1)) Then
            Range(Cells(lRows - lLast, 1), Cells(i, 1)).EntireRow.Copy Destination:=sh.Range("A" & sh.Cells(Rows.Count, 1).End(xlUp).Row).Offset(1, 0)
        End If

 

[zabiullakhan]

No.. It is not working for the last part of the data.

 

[Marcelo Branco]

Hi,

Maybe this
(adjust the sheet names on the two first lines of code after the Dims)

Sub copy10()
    Dim wkOrigin As Worksheet, wkDest As Worksheet
    Dim LR As Long, i As Long, j As Long
 
    Set wkOrigin = Sheets("Sheet1")
    Set wkDest = Sheets("Sheet2")
 
    With wkOrigin
        LR = .Cells(.Rows.Count, "A").End(xlUp).Row
        For i = 1 To LR Step 10
            j = i + 9
            If j > LR Then j = LR
            .Rows(i & ":" & j).Copy wkDest.Rows(i & ":" & j)
        Next i
    End With
End Sub

HTH

M.

 

[SydneyGeek]

Try...

Sub CopyLoop()
    Dim ChunkSize As Integer
    Dim rwLast_Source As Long
    
    Range("A1").Select
    ChunkSize = 10
    
    rwLast_Source = Range("A" & Rows.Count).End(xlUp).Row
    Do While ActiveCell.Row <= rwLast_Source
        ActiveCell.Resize(ChunkSize, 1).EntireRow.Copy _
            Destination:=Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        ActiveCell.Offset(ChunkSize, 0).Select
    Loop
End Sub

Denis

 

[zabiullakhan]

Hi SydneyGeek - This is cool it works as i wanted, Thanks. However the copied data gets pasted from the 2nd row and can it be from the 1st row. am trying to edit the code for 1st rows its not working out.

Please let me know if this can be done.

Thanks a lot for all your sullutions.

 

[SydneyGeek]

Try this version.

Sub CopyLoop()
    Dim ChunkSize As Integer
    Dim rwLast_Source As Long
    
    'clear out Sheet2, then copy Row 1 across
    Sheets("Sheet2").Range("A1").CurrentRegion.ClearContents
    Range("A1").EntireRow.Copy _
        Destination:=Sheets("Sheet2").Range("A1")
    
    'now do the rest in groups determined by the ChunkSize
    Range("A2").Select
    ChunkSize = 10
    
    rwLast_Source = Range("A" & Rows.Count).End(xlUp).Row
    Do While ActiveCell.Row <= rwLast_Source
        ActiveCell.Resize(ChunkSize, 1).EntireRow.Copy _
            Destination:=Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        ActiveCell.Offset(ChunkSize, 0).Select
    Loop
End Sub

Denis