Copy Column Table x times and add counter

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.

Attachment 20726

Can anybody please help me?

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

try:

Code:

---

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

---

Quote:

---

Originally Posted by mancubus

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

try:

Code:

---

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 :D

Thank you