Copy and Pasting Loop

[Lyrad39]

Good day Community,

I am intending to loop and copy the tables (K4:T20) as well as other tables on the right till the end, pasting them below row 20 and so on. However, I am stuck with the loop code and I hope to seek your help with it. Attached photo as shown for example.

These are the codes gotten with recording but I am unable to figure it out:

Sub Macro4()
'
' Macro4 Macro
'

'
    Range("K4:T20").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=3
    Range("A21").Select
    ActiveSheet.Paste
    Range("U4:AD20").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=15
    Range("A38").Select
    ActiveSheet.Paste
End Sub

 

[Peter_SSs]

You're welcome. Thanks for the confirmation.

 

[Lyrad39]

Good day Peter,

Would you know how I could adjust the codes to allow me to copy down the tables without following the format provided above?

Thank you.

 

[Peter_SSs]

Not quite sure that I understand. If this is not what you want please clarify with example and/or reference to the original sample data.

Sub MoveTables_v3()
  Dim Lastcol As Long, c As Long
  
  Application.ScreenUpdating = False
  Columns("A:J").Insert
  Lastcol = Cells.Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
  For c = 11 To Lastcol Step 10
    Cells(5, c).Resize(16, 10).Copy
    Range("C" & Rows.Count).End(xlUp).Offset(1, -2).PasteSpecial xlPasteValues
  Next c
  ActiveSheet.UsedRange.Offset(, 10).Clear
  Application.ScreenUpdating = True
End Sub

 

[Lyrad39]

Sorry I meant what if my tables are starting from row 20 instead of row 4 as shown in the photo, how should I edit the codes to have it copy and paste from row 20 instead.

 

[Peter_SSs]

Sorry I meant what if my tables are starting from row 20 instead of row 4 ... how should I edit

Sub MoveTables_v2a()
  Dim Lastcol As Long, c As Long
 
  Lastcol = Cells.Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
  For c = 11 To Lastcol Step 10
    Cells(21, c).Resize(16, 10).Cut Destination:=Range("C" & Rows.Count).End(xlUp).Offset(1, -2)
  Next c
  ActiveSheet.UsedRange.Offset(, 10).ClearContents
End Sub