Create Macro To Copy Moving Range of Rows

Hi

Here goes

Sub aaa()
  
  Dim SrcSH As Worksheet
  Dim OutSH As Worksheet
  Set SrcSH = ActiveSheet
  Sheets.Add after:=Sheets(Sheets.Count)
  Set OutSH = ActiveSheet
  
  SrcSH.Select
  Rows("10:" & Cells(Rows.Count, 1).End(xlUp).Row).EntireRow.Copy
  OutSH.Cells(Rows.Count, 1).End(xlUp).PasteSpecial (xlPasteValues)
  Rows("10:" & Cells(Rows.Count, 1).End(xlUp).Row).EntireRow.Copy
  Cells(Rows.Count, 1).End(xlUp).Offset(3, 0).PasteSpecial (xlPasteValues)
  Application.CutCopyMode = False
  
  
End Sub

rylo