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

 

[Nelson78]

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

Exactly, if you mean this:

With .Range("A1:P" & lr)

 

[steve the fish]

Ok try changing the line:

If .SpecialCells(xlCellTypeVisible).Count > 2 Then

to

If .SpecialCells(xlCellTypeVisible).Rows.Count > 1 Then

 

[Nelson78]

It seems ok.
Thank you.