paste to the next available row

[Rubber Beaked Woodpecker]

Hi guys

I use the following code which works very well.

Sub RS()
   
Dim source As Worksheet
Dim destination As Worksheet
Dim emptyColumn As Long

Set source = Sheets("Sheet1")
Set destination = Sheets("Sheet8")

source.Range("Z2:Z38").Copy 

emptyColumn = destination.Cells(28, destination.Columns.Count).End(xlToLeft).Column

If IsEmpty(destination.Range("A28")) Then
    destination.Cells(1, 1).PasteSpecial Transpose:=True
       
Else
    emptyColumn = emptyColumn + 1
    destination.Cells(28, emptyColumn).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
        
  destination.Cells(28, emptyColumn).PasteSpecial Paste:=xlPasteFormats
  
Sheets("Sheet8").Select
         ActiveSheet.Calculate
        
    
End If
   
End Sub

However I would also now like the macro to perform the following after the original code has been executed.

Copy Sheet1 AA4:AB4

and paste to the next available row on Sheet8 starting at A250.

The next time the macro is run is will again copy Sheet1 AA4:AB4 and paste to the next available row on Sheet8 which will be A251
The next time the macro is run is will again copy Sheet1 AA4:AB4 and paste to the next available row on Sheet8 which will be A252
The next time the macro is run is will again copy Sheet1 AA4:AB4 and paste to the next available row on Sheet8 which will be A253... and so on

Any advice on this please.

Many thanks

RBW

 

[Trebor76]

Hi RBW,

Here's one way:

Option Explicit
Sub Macro1()

    Dim lngPasteRow As Long
    
    Application.ScreenUpdating = False
    
    With ThisWorkbook
        lngPasteRow = .Sheets("Sheet8").Cells(Rows.Count, "A").End(xlUp).Row + 1
        lngPasteRow = IIf(lngPasteRow < 250, 250, lngPasteRow)
        .Sheets("Sheet1").Range("AA4:AB4").Copy Destination:=.Sheets("Sheet8").Range("A" & lngPasteRow)
    End With
    
    Application.ScreenUpdating = True
    
End Sub

Regards,

Robert