Copying Non-contiguous columns from one workbook and pasting them into a Table in another workbook

[mrpavlos]

Hello all
I am a first-time poster to this forum, but have read through a lot of the posts and have gained so much knowledge to help in my own journey as a relative novice in learning and applying VBA in my job as an analyst.

I have a question as to how to paste certain non-contiguous columns from a worksheet in one workbook to a Table in a worksheet in another workbook and I would really appreciate any help or guidance you could give me. I have posted an example of the code I have tried so far below. I get a data type mismatch error (13) on the line:

Set vCOLs = Array("A", "C", "D", "H", "I", "M", "P", "T", "U", "V")

What I am trying to do is as follows:
1) From my destination worbook pen the SKUListing Workbook (my source workbook) and copy the data from row 2 in columns A,C,D,H,I,M,P,T,U,V, down to the last populated row, from the SKUListing sheet
2) Paste this data into columns 1 through to 10 (the column headings of the destination workbook match those of the source) into column A of Table1 on Sheet1 of the destination workbook. Because there will already be data in the destination workbook I just need to have this new data populated into the next available row. Basically each week I will be appending new data as the source workbook itself gets refreshed with new data. The code I have tried thus far which fails (due to extent of my knowledge) is as follows:

Sub InsertLockStockData()

Dim WB1 As Workbook
Dim WB2 As Workbook

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Set WB1 = ThisWorkbook
Set WB2 = Workbooks.Open("C:\Users\mrpavlos\Desktop\Latest UTL Report Templates\Stock Reports\SKU Listing\SKUListing.xlsb", Local:=True)

Dim a As Long, b As Long, c As Long, lr As Long
Dim vCOLs As Variant, vVALs As Variant, vSRCs As Variant

With WB2.Worksheets("SKUListing")

Set vCOLs = Array("A", "C", "D", "H", "I", "M", "P", "T", "U", "V")

lr = Application.Max(.Cells(.Rows.Count, "A").End(xlUp).Row, _
.Cells(.Rows.Count, "C").End(xlUp).Row, _
.Cells(.Rows.Count, "D").End(xlUp).Row, _
.Cells(.Rows.Count, "H").End(xlUp).Row, _
.Cells(.Rows.Count, "I").End(xlUp).Row, _
.Cells(.Rows.Count, "M").End(xlUp).Row, _
.Cells(.Rows.Count, "P").End(xlUp).Row, _
.Cells(.Rows.Count, "T").End(xlUp).Row, _
.Cells(.Rows.Count, "U").End(xlUp).Row, _
.Cells(.Rows.Count, "V").End(xlUp).Row)

vSRCs = .Range(.Cells(2, "A"), .Cells(lr, "V")).Value2

ReDim vVALs(1 To lr - 1, 1 To UBound(vCOLs) + 1)

For a = 1 To lr - 1
For b = LBound(vCOLs) To UBound(vCOLs)
vVALs(a, b + 1) = vSRCs(a, vCOLs(b))
Next b
Next a


WB1.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(UBound(vVALs, 1), UBound(vVALs, 2)) = vVALs

End With

Application.CutCopyMode = False

WB2.Close False

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

 

[Fluff]

Hi & welcome to MrExcel.
Remove the word "Set", you only "Set" objects.

 

[mrpavlos]

Cheers Fluff. Thank you for the advice and the welcome. Much appreciated. I tried the code again without the Set on this particular line but I still get the same mismatch error showing for this line

 

[mrpavlos]

My apologies. I meant to write that the mismatch error is showing against the line (in bold):

For a = 1 To lr - 1
For b = LBound(vCOLs) To UBound(vCOLs)
vVALs(a, b + 1) = vSRCs(a, vCOLs(b))
Next b
Next a

 

[Fluff]

You need to change the VCOLS array to column numbers rather than column letters

 

[mrpavlos]

Thank you again Fluff. That solved the problem I had beautifully and it works now the way that I needed. I also learnt something new about arrays. Many thanks again for your time and your help

 

[Fluff]

Glad to help & thanks for the feedback

 

[Peter_SSs]

I also learnt something new about arrays.

Something else for you then..

Instead of loading the data from all columns into vSRCs and then looping through the relevant columns & every row to get all the individual items you want into vVALs, you can load all the items you want directly into vVALS from the worksheet and paste them into the other sheet.

vCOLs = Array(1, 3, 4, 8, 9, 13, 16, 20, 21, 22)
With WB2.Worksheets("SKUListing")
  lr = .Columns("A:V").Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  vVALs = Application.Index(.Range("A:V"), Evaluate("row(2:" & lr & ")"), vCOLs)
End With
WB1.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(UBound(vVALs, 1), UBound(vVALs, 2)) = vVALs

In fact, you don't even need to put the required values into an array at all, you can transfer them directly from the source sheet to the destination sheet.

vCOLs = Array(1, 3, 4, 8, 9, 13, 16, 20, 21, 22)
With WB2.Worksheets("SKUListing")
  lr = .Columns("A:V").Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  WB1.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(lr - 1, UBound(vCOLs) - LBound(vCOLs) + 1).Value = Application.Index(.Cells, Evaluate("row(2:" & lr & ")"), vCOLs)
End With

 

[mrpavlos]

Cheers Peter. Thank you so much for this. I really appreciate it. Will definitely try this method.

 

[Peter_SSs]

Cheers Peter. Thank you so much for this. I really appreciate it. Will definitely try this method.

You're welcome. Glad to contribute.