Excel Forum

Code: Select all

Option Explicit

Sub SendToPaste()
Dim r1 As Range
Dim r2 As Range
    With Worksheets("Sheet1")
       Set r1 = .Range(.Range("A2"), .Range("J65536").End(xlUp))
    End With
    With Worksheets("Sheet2")
       Set r2 = .Range(.Range("A2"), .Range("J65536").End(xlUp))
    End With
       PasteData r1
       PasteData r2
    MsgBox "Complete"
End Sub

Sub PasteData(r)
Dim r3 As Range
Dim i As Integer
With Worksheets("Sheet3")
       i = .Range("A65536").End(xlUp).Row + 1
       Set r3 = .Cells(i, "A")
End With
       If r.Row <> 1 Then
            r.Copy r3
        End If
End Sub