Macro to copy and paste column by column from one sheet into master sheet by header to maintain growing data

Question

I am fairly new to Excel VBA and have been trying to look for (as well as come up with my own) solutions to a dilemma I am facing. Routinely, I receive raw data files from a colleague and these raw data files may have varying number of columns but consistent header names. I have in my workbook, a master spreadsheet that I want to keep up to date by appending the new data (so keep appending data of new spreadsheet to next empty row). I would like to create a macro that can take the imported spreadsheet (say, spreadsheet A) and look at the header value of a column, copy the column range (starting from row 2 to end of populated within column), go to spreadsheet Master, look for header value, and paste the column range in the next empty cell down in the column. And this procedure would be for all columns present in spreadsheet A.

Any help/guidance/advice would be very much appreciated.

Ex) I have "master" sheet and "imported" sheet. I want to take the "imported" sheet, look at headers in row 1, starting from column 1. If that header is present in "master" sheet, copy the column (minus the header) from "imported sheet" and paste into "master" under the appropriate column header starting from the next empty cell in that column. What I ultimately want to do is keep the "master" sheet with historical data but the "imported" sheet contains columns which moves around so I just couldn't copy and paste the range starting from next empty cell in master.

Answer 1

Untested but compiles OK:

Sub CopyByHeader()

    Dim shtA As Worksheet, shtB As Worksheet
    Dim c As Range, f As Range
    Dim rngCopy As Range, rngCopyTo

    Set shtA = ActiveSheet ' "incoming data" - could be different workbook
    Set shtB = ThisWorkbook.Sheets("Master")

    For Each c In Application.Intersect(shtA.UsedRange, shtA.Rows(1))

        'only copy if >1 value in this column (ie. not just the header)
        If Len(c.Value) > 0 And Application.CountA(c.EntireColumn) > 1 Then

            Set f = shtB.Rows(1).Find(what:=c.Value, LookIn:=xlValues, _
                                         LookAt:=xlWhole)
            If Not f Is Nothing Then

                Set rngCopy = shtA.Range(c.Offset(1, 0), _
                    shtA.Cells(Rows.Count, c.Column).End(xlUp))

                Set rngCopyTo = shtB.Cells(Rows.Count, _
                                f.Column).End(xlUp).Offset(1, 0)
                'copy values
                rngCopyTo.Resize(rngCopy.Rows.Count, 1).Value = rngCopy.Value

            End If
        End If
    Next c

End Sub

EDIT: updated to only copy columns which have any content, and to only copy values

Answer 2

I cannot get the above to work, and need the same result as the original question. Any thoughts on what is missing? I thought I changed everything that needed to be changed to fit my sheets:

Sub CopyByHeader()


Dim shtMain As Worksheet, shtImport As Worksheet

Dim c As Range, f As Range

Dim rngCopy As Range, rngCopyTo

Set shtImport = ActiveSheet

' "Import"

Set shtMain = ThisWorkbook.Sheets("Main")

For Each c In Application.Intersect(shtImport.UsedRange, shtImport.Rows(1))

'only copy if >1 value in this column (ie. not just the header)

If Len(c.Value) > 0 And Application.CountA(c.EntireColumn) > 1 Then

Set f = shtMain.Rows(1).Find(what:=c.Value, LookIn:=xlValues, _
LookAt:=xlWhole)

If Not f Is Nothing Then

Set rngCopy = shtImport.Range(c.Offset(1, 0), _
shtImport.Cells(Rows.Count, c.Column).End(xlUp))
Set rngCopyTo = shtMain.Cells(Rows.Count, _
f.Column).End(xlUp).Offset(1, 0)

'copy values

rngCopyTo.Resize(rngCopy.Rows.Count, 1).Value = rngCopy.Value

End If

 End If

 Next c

 End Sub

Thanks, Ryan