Copy Column Table x times and add counter

[arns]

Hi there,


I am trying create a VBA code to copy My Product list (Table1) to my Master table (Table2).
I would like to repeat the process 12 times and add a "Month no" in the adjacent column.

Seems like an easy task but somehow I am going nowhere with this.

Copy_x_Times.JPG

Can anybody please help me?

[mancubus]

i assume the second table has Header Row only, ie, an empty table.

try:

Sub vbax_61109_copy_tbl_to_tbl_add_counter()
  
    Dim tblCopy As ListObject, tblPaste As ListObject
    Dim i As Long, Num As Long, PasteRow As Long
    Dim tblData
    
    Set tblCopy = Worksheets("Sheet1").ListObjects("Table1")
    Set tblPaste = Worksheets("Sheet1").ListObjects("Table2")
    'change sheet name and table names to suit
    
    With tblCopy
        tblData = .ListColumns(1).DataBodyRange.Value
        Num = .ListColumns(1).DataBodyRange.Count
    End With
    
    With tblPaste
        .Resize .Range.Resize(Num * 12, .Range.Columns.Count)
        For i = 1 To 12
            PasteRow = Num * (i - 1) + 1
            .ListColumns(1).DataBodyRange.Cells(PasteRow).Resize(Num, 1).Value = tblData
            .ListColumns(2).DataBodyRange.Cells(PasteRow).Resize(Num, 1).Value = i
        Next i
    End With
        
End Sub

[arns]

i assume the second table has Header Row only, ie, an empty table.

try:

Sub vbax_61109_copy_tbl_to_tbl_add_counter()
  
    Dim tblCopy As ListObject, tblPaste As ListObject
    Dim i As Long, Num As Long, PasteRow As Long
    Dim tblData
    
    Set tblCopy = Worksheets("Sheet1").ListObjects("Table1")
    Set tblPaste = Worksheets("Sheet1").ListObjects("Table2")
    'change sheet name and table names to suit
    
    With tblCopy
        tblData = .ListColumns(1).DataBodyRange.Value
        Num = .ListColumns(1).DataBodyRange.Count
    End With
    
    With tblPaste
        .Resize .Range.Resize(Num * 12, .Range.Columns.Count)
        For i = 1 To 12
            PasteRow = Num * (i - 1) + 1
            .ListColumns(1).DataBodyRange.Cells(PasteRow).Resize(Num, 1).Value = tblData
            .ListColumns(2).DataBodyRange.Cells(PasteRow).Resize(Num, 1).Value = i
        Next i
    End With
        
End Sub

Wow, that was quick
This is brilliant, exactly what I needed. Thank you mancubus

Thank you