PDA

View Full Version : [SOLVED] Copy Column Table x times and add counter



arns
10-23-2017, 10:10 AM
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.

20726

Can anybody please help me?

mancubus
10-23-2017, 01:38 PM
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
10-23-2017, 02:49 PM
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 :D

Thank you