Copy and paste entire rows

[Nelson78]

Hello everybody.

I need to copy and paste all the rows from sheet Two to sheet One (beginning from the first empty row).
At the moment, the copy and paste works for only one row.

Where is the mistake?

Thank's.

Sub transfer()

Dim lr As Long, lr2 As Long, r As Long

lr = Sheets("Two").Cells(Rows.Count, "A").End(xlUp).Row
lr2 = Sheets("One").Cells(Rows.Count, "A").End(xlUp).Row

For r = lr To 2 Step -1

Rows(r).Copy Destination:=Sheets("One").Range("A" & lr2 + 1)

Next r

End Sub

 

[steve the fish]

Re: Copy and past entire rows

You dont need to use a loop. Try replacing the loop with this:

Sheets("Two").Rows("1:" & lr).Copy Sheets("One").Range("A" & lr2 + 1)

 

[hiker95]

Re: Copy and past entire rows

Nelson78,

So that we can get it right on the first try, can we see what your raw data worksheets look like, and, can we see what the results should look like?

You can post your workbook/worksheets to the following free site (sensitive data changed), mark the workbook for sharing, and, provide us with a link to your workbook:

https://dropbox.com

 

[Nelson78]

Re: Copy and past entire rows

You dont need to use a loop. Try replacing the loop with this:

Sheets("Two").Rows("1:" & lr).Copy Sheets("One").Range("A" & lr2 + 1)

It is ok except for a detail (because of the header).

Sheets("Two").Rows("[B]2[/B]:" & lr).Copy Sheets("One").Range("A" & lr2 + 1)

I used the loop because the final target is copying only rows that contains specific values, and may be I can't avoid it.

Example:

Copy and paste all the entire rows which value in column A is "White" and in column B "London".

 

[Nelson78]

Re: Copy and past entire rows

Nelson78,

So that we can get it right on the first try, can we see what your raw data worksheets look like, and, can we see what the results should look like?

You can post your workbook/worksheets to the following free site (sensitive data changed), mark the workbook for sharing, and, provide us with a link to your workbook:

https://dropbox.com

Sometimes I've posted examples, but in this case it seemed to me so easy explain the matter in words. It is a theoric one.
Anyway, I will follow your advice.

Theak's.

 

[steve the fish]

Re: Copy and past entire rows

Theres plenty of ways to do that. Heres a way using the autofilter as you have a header:

Application.ScreenUpdating = False
 
Dim lr As Long, lr2 As Long

lr2 = Sheets("One").Cells(Rows.Count, "A").End(xlUp).Row

With Sheets("Two")
    If .AutoFilterMode Then .AutoFilterMode = False
    lr = .Range("A" & .Rows.Count).End(xlUp).Row
    If lr < 2 Then Exit Sub
    With .Range("A1:B" & lr)
        .AutoFilter
        .AutoFilter Field:=1, Criteria1:="white"
        .AutoFilter Field:=2, Criteria1:="london"
        If .SpecialCells(xlCellTypeVisible).Count > 2 Then
            .Offset(1, 0).Resize(lr - 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("One").Range("A" & lr2 + 1)
        End If
    End With
    .AutoFilterMode = False
End With

Application.ScreenUpdating = True

 

[Nelson78]

Re: Copy and past entire rows

Theres plenty of ways to do that. Heres a way using the autofilter as you have a header:

Application.ScreenUpdating = False
 
Dim lr As Long, lr2 As Long

lr2 = Sheets("One").Cells(Rows.Count, "A").End(xlUp).Row

With Sheets("Two")
    If .AutoFilterMode Then .AutoFilterMode = False
    lr = .Range("A" & .Rows.Count).End(xlUp).Row
    If lr < 2 Then Exit Sub
    With .Range("A1:B" & lr)
        .AutoFilter
        .AutoFilter Field:=1, Criteria1:="white"
        .AutoFilter Field:=2, Criteria1:="london"
        If .SpecialCells(xlCellTypeVisible).Count > 2 Then
            .Offset(1, 0).Resize(lr - 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("One").Range("A" & lr2 + 1)
        End If
    End With
    .AutoFilterMode = False
End With

Application.ScreenUpdating = True

It works well also with huge amount of datas (10000 rows, 10 columns).

I've added the above instructions in event of no data filtered (Run-Time Error 1004 No cells were found).

On Error Resume Next
.......
On Error GoTo 0

 

[steve the fish]

Re: Copy and past entire rows

You shouldnt get that error. Thats what this is for:

If .SpecialCells(xlCellTypeVisible).Count > 2 Then

 

[Nelson78]

Re: Copy and past entire rows

I confirm the error in the following line.

.Offset(1, 0).Resize(lr - 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("One").Range("A" & lr2 + 1)

Consider I've adapted your suggestion to the concrete situation, maybe something else could affect the operation.

 

[steve the fish]

If you are getting an error then you will have changed the range. The greater than 2 bit must be equal to the number of cells in your header range