Pulling data from multiple workbooks to a master workbook using headers

RedVines

New Member
Joined
Jun 22, 2018
Messages
3
I have three workbooks that I am trying to move into one by matching the headers (we’ll refer to the workbooks as WB1, WB2, WB3 and the new as the master sheet). Some information about the existing workbooks and the master sheet.

Master sheet is blank, except for the headers. Headers match headers used on WB1, WB2, and WB3, but may be in a different order.

Not all headers from WB1, WB2, and WB3 will be used on the mater sheet.

Some headers from WB1, WB2, and WB3 are duplicative, I would want to pull the data anyways but would not want to overwrite information from another workbook. I have plans to go back and dedupe once all of my data is transferred.

Some headers on WB1 do not match headers of WB2 or WB3 but do match some headers on the master sheet.

Some headers from WB2 do not match headers from WB1 or WB3, but do match some headers on the master sheet.

Some headers from WB3 do not match WB1 or WB2, but do match some headers on the master sheet.

Originally, I was going to try and use a index match or vlookup to pull the data, but my formula started to get messy, my VBA skills are practically non-existent. I saw there was a similar post yesterday that used the below, but I wasn’t sure how I could manipulate the code so it would work for me (I did copy the workbooks into various sheets on the master sheet to apply the code below).

(Credit to mumps)

Code:
Sub CopyCols()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet
    Set srcWS = Sheets("Sheet1")
    Set desWS = Sheets("Sheet2")
    Dim LastRow As Long
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim lColumn As Long
    lColumn = srcWS.Cells(1, srcWS.Columns.Count).End(xlToLeft).Column
    Dim header As Range, foundHeader As Range
    For Each header In srcWS.Range(srcWS.Cells(1, 1), srcWS.Cells(1, lColumn))
        Set foundHeader = desWS.Rows(1).Find(header, LookIn:=xlValues, lookat:=xlWhole)
        If Not foundHeader Is Nothing Then
            srcWS.Range(srcWS.Cells(2, header.Column), srcWS.Cells(LastRow, header.Column)).Copy desWS.Cells(2, foundHeader.Column)
        End If
    Next header
    Application.ScreenUpdating = True
End Sub


Apologies if this was confusing and many many many thanks if you are able to assist.
 
Last edited by a moderator:

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.
The macro assumes that all workbooks are open, the destination sheet is named "Master", all the source sheets are named "Sheet1" and all sheets have headers in row 1 and data starting in row 2. If this is not the case, the sheet names and row numbers in the code will have to be modified. Place the macro in a regular module in the master workbook and run it from there.
Code:
Sub CopyCols()
    Application.ScreenUpdating = False
    Dim ws As Worksheet, desWS As Worksheet, WB As Workbook
    Set desWS = ThisWorkbook.Sheets("Master")
    Dim header As Range, foundHeader As Range
    Dim LastRow As Long, lColumn As Long
    For Each WB In Workbooks
        If WB.Name <> ThisWorkbook.Name Then
            Set ws = WB.Sheets("Sheet1")
            LastRow = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            lColumn = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
            For Each header In ws.Range(ws.Cells(1, 1), ws.Cells(1, lColumn))
                Set foundHeader = desWS.Rows(1).Find(header, LookIn:=xlValues, lookat:=xlWhole)
                If Not foundHeader Is Nothing Then
                    ws.Range(ws.Cells(2, header.Column), ws.Cells(LastRow, header.Column)).Copy desWS.Cells(desWS.Rows.Count, foundHeader.Column).End(xlUp).Offset(1, 0)
                End If
            Next header
        End If
    Next WB
    Application.ScreenUpdating = True
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,524
Messages
6,114,117
Members
448,549
Latest member
brianhfield

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