VBA to copy columns from one workbook to another based on column title. Source workbook name changes every new download.

Dancing_Bear_101

New Member
Joined
Jul 1, 2021
Messages
4
Office Version
  1. 365
  2. 2016
  3. 2013
  4. 2011
  5. 2010
Platform
  1. Windows
Background: This is my first time dealing with macros. I will have two workbooks that I’ll be using. The first workbook (will call it Source) contains data source which is downloaded daily and workbook name changes, but the worksheet name remains the same "HOTT Detailed Module". The second workbook (will call it Final) will have data available formatted as a table under "HOTT Detailed Module" worksheet, which will need to be updated using the data copied from the first workbook based on matching column titles.

* I want the macro to copy the specified columns in the ‘Source’ workbook based on column title, copy that data in said specified columns all the way down to the last row of existing data (instead of the entire column), and paste it onto the ‘Final’ workbook under the same column title.

The reason why I have to specify which headers to find is because the headers in the ‘Source’ workbook don't match up exactly in terms of positioning with the "Final" workbook, for there have been manual column added to the destination table within the "Final" workbook.

Source workbook example:

Created On DateSold-ToSold-To NameSales DocumentCustomer PODelivery BlockBilling BlockOrder DescriptionContact PersonLatest Delivery DateFirst Date of Sales Item

Final workbook example:
  1. Columns in bold have been manually added

Created On DateYear21+Sold-ToSold-To NameSales DocumentCustomer PODelivery BlockBilling BlockOrder DescriptionContact PersonLatest Delivery DateFirst Date of Sales ItemOrder Block

I want macro to recognize that the columns need to be pasted within the correct columns based on column title. For if columns get pasted incorrectly, the whole model within the second "Final" workbook will fail.

I’m sorry if my wording isn’t accurate – I tried to explain the best I could. It’d be awesome if someone could help me out on this! Thanks!
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,525
Office Version
  1. 2016
Platform
  1. Windows
The code provided can be simplified/shortened by more looping I suppose but writing it this way made it easy to understand the flow and easy to tweak to your need. When the macro is run, it will ask for Source file and execute the rest of the program.

VBA Code:
Sub CopySource2Final()

Dim n As Long
Dim colSource(11) As String, colFinal(11) As String
Dim cell As Range, rngHeaderSource As Range, rngHeaderFinal As Range, rngCopy As Range
Dim Fname As Variant
Dim wsSource As Worksheet, wsFinal As Worksheet
Dim wbSource As Workbook, wbFinal As Workbook
Dim rngTotal As Range

Application.ScreenUpdating = False

' Define this Workbook as wbFinal
Set wbFinal = ActiveWorkbook
' Define working sheet in wbFinal. Change sheet name accordingly
Set wsFinal = wbFinal.Sheets("HOTT Detailed Module")

' Open Source Workbook
Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls; *.xlsx; *.xlsm; *.xlsb), *.xls; *.xlsx; *.xlsm; *.xlsb", Title:="Select a File")
If Fname = False Then Exit Sub                         'CANCEL is clicked

' Define opened Workbook as wbSource while opening it.
Set wbSource = Workbooks.Open(Filename:=Fname, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
' Define working sheet in wbSource. Change sheet name accordingly
Set wsSource = wbSource.Sheets("HOTT Detailed Module")

' Define header range in Source workbook. Assuming on row1 (Change if required)
Set rngHeaderSource = wsSource.Range("A1", wsSource.Cells(1, wsSource.Columns.Count).End(xlToLeft))

' Find and define column letter for Source
n = -1
For Each cell In rngHeaderSource
    Select Case cell
        Case "Created On Date"
            n = n + 1
            colSource(n) = Split(cell.Address, "$")(1)
        Case "Sold-To"
            n = n + 1
            colSource(n) = Split(cell.Address, "$")(1)
        Case "Sold-To Name"
            n = n + 1
            colSource(n) = Split(cell.Address, "$")(1)
        Case "Sales Document"
            n = n + 1
            colSource(n) = Split(cell.Address, "$")(1)
        Case "Customer PO"
            n = n + 1
            colSource(n) = Split(cell.Address, "$")(1)
        Case "Delivery Block"
            n = n + 1
            colSource(n) = Split(cell.Address, "$")(1)
        Case "Billing Block"
            n = n + 1
            colSource(n) = Split(cell.Address, "$")(1)
        Case "Order Description"
            n = n + 1
            colSource(n) = Split(cell.Address, "$")(1)
        Case "Contact Person"
            n = n + 1
            colSource(n) = Split(cell.Address, "$")(1)
        Case "Latest Delivery Date"
            n = n + 1
            colSource(n) = Split(cell.Address, "$")(1)
        Case "First Date of Sales Item"
            n = n + 1
            colSource(n) = Split(cell.Address, "$")(1)
    End Select
Next

' Define header range in Final workbook. Assuming on row1 (Change if required)
Set rngHeaderFinal = wsFinal.Range("A1", wsFinal.Cells(1, wsFinal.Columns.Count).End(xlToLeft))

' Find and define column letter for Final
n = -1
For Each cell In rngHeaderFinal
    Select Case cell
        Case "Created On Date"
            n = n + 1
            colFinal(n) = Split(cell.Address, "$")(1)
        Case "Sold-To"
            n = n + 1
            colFinal(n) = Split(cell.Address, "$")(1)
        Case "Sold-To Name"
            n = n + 1
            colFinal(n) = Split(cell.Address, "$")(1)
        Case "Sales Document"
            n = n + 1
            colFinal(n) = Split(cell.Address, "$")(1)
        Case "Customer PO"
            n = n + 1
            colFinal(n) = Split(cell.Address, "$")(1)
        Case "Delivery Block"
            n = n + 1
            colFinal(n) = Split(cell.Address, "$")(1)
        Case "Billing Block"
            n = n + 1
            colFinal(n) = Split(cell.Address, "$")(1)
        Case "Order Description"
            n = n + 1
            colFinal(n) = Split(cell.Address, "$")(1)
        Case "Contact Person"
            n = n + 1
            colFinal(n) = Split(cell.Address, "$")(1)
        Case "Latest Delivery Date"
            n = n + 1
            colFinal(n) = Split(cell.Address, "$")(1)
        Case "First Date of Sales Item"
            n = n + 1
            colFinal(n) = Split(cell.Address, "$")(1)
    End Select
Next

' Transfer data from Source to Final
For n = 0 To 10
    wsSource.Range(colSource(n) & 2, Cells(wsSource.Rows.Count, colSource(n)).End(xlUp)).Copy wsFinal.Range(colFinal(n) & "2")
Next

End Sub
 

Dancing_Bear_101

New Member
Joined
Jul 1, 2021
Messages
4
Office Version
  1. 365
  2. 2016
  3. 2013
  4. 2011
  5. 2010
Platform
  1. Windows
Forgive my ignorance for this would mark my first time ever using a macro, but I would simply copy the code provided when opening the source file? Do I have to have both files open?
 

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,525
Office Version
  1. 2016
Platform
  1. Windows
Forgive my ignorance for this would mark my first time ever using a macro, but I would simply copy the code provided when opening the source file? Do I have to have both files open?
The code should be copied into normal module of the wbFinal. Run the program and it will ask for location file. Browse to the file and it will continue run until complete the task.
 

Dancing_Bear_101

New Member
Joined
Jul 1, 2021
Messages
4
Office Version
  1. 365
  2. 2016
  3. 2013
  4. 2011
  5. 2010
Platform
  1. Windows

ADVERTISEMENT

If I needed to add more columns, I can just build on the code?
 

Dancing_Bear_101

New Member
Joined
Jul 1, 2021
Messages
4
Office Version
  1. 365
  2. 2016
  3. 2013
  4. 2011
  5. 2010
Platform
  1. Windows
View attachment 42953

I went ahead and ran, and the following error occured.

Also, where you state "Define header range in Source workbook. Assuming on row1 (Change if required)"

All I did was update where the columns began from both wbSource and WbFinal. Is that correct?
 

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,525
Office Version
  1. 2016
Platform
  1. Windows
Sorry. I was away. My office is currently under lockdown area due to Covid-19 and is closed until Aug :(. I did not able to download your sample as it is not no more there.

Rich (BB code):
' Define header range in Source workbook. Assuming on row1 (Change if required)
Set rngHeaderSource = wsSource.Range("A1", wsSource.Cells(1, wsSource.Columns.Count).End(xlToLeft))

In
Set rngHeaderSource = wsSource.Range("A1", wsSource.Cells(1, wsSource.Columns.Count).End(xlToLeft))

The A1 is start column and row

the
wsSource.Cells(1, wsSource.Columns.Count).End(xlToLeft)

The 1 is for row 1 and the line above acts like you select last column on worksheet row 1. Press CTRL + ArrowLeft. The cursor will stop on last occupied cell on row 1 (which is suppose to be last column of headers)

So, you may change A1 for start column and 1 for whatever row. Note that the row must match the start column row.
 

Forum statistics

Threads
1,141,073
Messages
5,704,140
Members
421,328
Latest member
mippy

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
Top