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.

 

[SydneyGeek]

You can find the last used row by using the End method from the bottom of the sheet.
Then copy rows using something like...
ActiveCell.Resize(10,1).EntireRow.Copy

To paste into Sheet2, find the last used row in that sheet and then paste into the next row.

Then you can offset by 10 rows, and repeat. Stop the loop when ActiveCell.Row is greater than the last row with content.

Denis

 

[Sektor]

Sub Extract10Rows()
    
    Dim i As Long, sh As Worksheet
    
    Set sh = Worksheets("Sheet2")
    
    For i = 1 To Range("A1").End(xlDown).Rows.Count
        If i Mod 10 = 0 Then
            Range(Cells(i, 1), Cells(i - 9, 1)).Copy Destination:=sh.Range("A" & sh.Cells(Rows.Count, 1).End(xlUp).Row+1)
        End If
    Next

End Sub

 

[zabiullakhan]

The below code dosent work as it dosent satisfys the condition in red

Sub Extract10Rows()
    
    Dim i As Long, sh As Worksheet
    
    Set sh = Worksheets("Sheet2")
    
    For i = 1 To Range("A1").End(xlDown).Rows.Count
       [COLOR=red] If i Mod 10 = 0 Then
[/COLOR]            Range(Cells(i, 1), Cells(i - 9, 1)).Copy Destination:=sh.Range("A" & sh.Cells(Rows.Count, 1).End(xlUp).Row+1)
        End If
    Next

End Sub

however i wan to copy all the rows for example

Total no of rows = 34

loop1 = 10 -> total 10 (start from 1st row to 10th row)
loop2 = 10 -> total 20 (start from 11th row to 20th row)
loop3 = 10 -> total 30 (start from 21st row to 30th row)
loop4 = 4 -> total 34 (start from 31st row to 34th row)

Please help

 

[Sektor]

Try this one:

Sub Extract10Rows()
    
    Dim lRows As Long, lLast As lost
    Dim i As Long, sh As Worksheet
    
    lRows = Range("A1").End(xlDown).Rows.Count
    Set sh = Worksheets("Sheet2")
    
    For i = 1 To lRows
        If i Mod 10 = 0 Then
            lLast = i
            Range(Cells(i, 1), Cells(i - 9, 1)).Copy Destination:=sh.Range("A" & sh.Cells(Rows.Count, 1).End(xlUp).Row).Offset(1, 0)
        ElseIf IsEmpty(Cells(i + 1, 1)) Then
            Range(Cells(i, 1), Cells(lRows - lLast, 1)).Copy Destination:=sh.Range("A" & sh.Cells(Rows.Count, 1).End(xlUp).Row).Offset(1, 0)
        End If
    Next

End Sub

 

[zabiullakhan]

No the loop dosent work as lRows has value 1

the code below is not giving us the total no of rows.. hence loop exits for the first time itself.

lRows = Range("A1").End(xlDown).Rows.Count

 

[Sektor]

lRows = Range("A1").End(xlDown).Row

 

[zabiullakhan]

its just copying coll A, i would like to copy all the col used

Please help

 

[Sektor]

Sub Extract10Rows()
    
    Dim lRows As Long, lLast As lost
    Dim i As Long, sh As Worksheet
    
    lRows = Range("A1").End(xlDown).Rows
    Set sh = Worksheets("Sheet2")
    
    For i = 1 To lRows
        If i Mod 10 = 0 Then
            lLast = i
            Range(Cells(i, 1), Cells(i - 9, 1)).[B][COLOR="Red"]EntireRow[/COLOR][/B].Copy Destination:=sh.Range("A" & sh.Cells(Rows.Count, 1).End(xlUp).Row).Offset(1, 0)
        ElseIf IsEmpty(Cells(i + 1, 1)) Then
            Range(Cells(i, 1), Cells(lRows - lLast, 1)).[B][COLOR="red"]EntireRow[/COLOR][/B].Copy Destination:=sh.Range("A" & sh.Cells(Rows.Count, 1).End(xlUp).Row).Offset(1, 0)
        End If
    Next

End Sub

 

[zabiullakhan]

code seem's to be going wrong in last loope, ifelse statement.

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

It copys the data 25 times