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

mrpavlos

New Member
Joined
Jul 28, 2018
Messages
23
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
 

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
Hi & welcome to MrExcel.
Remove the word "Set", you only "Set" objects.
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
You need to change the VCOLS array to column numbers rather than column letters
 
Upvote 0
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
 
Upvote 0
Glad to help & thanks for the feedback
 
Upvote 0
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.
Code:
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.
Code:
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
 
Last edited:
Upvote 0
Cheers Peter. Thank you so much for this. I really appreciate it. Will definitely try this method.
 
Upvote 0

Forum statistics

Threads
1,213,531
Messages
6,114,167
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top