vba 宏以逐列从一张工作表复制并粘贴到主工作表中的标题，以保持不断增长的数据

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

提问by AG10

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.

我对 Excel VBA 相当陌生，并且一直试图寻找（以及提出我自己的）解决方案来解决我面临的困境。通常，我从同事那里收到原始数据文件，这些原始数据文件的列数可能不同，但标题名称一致。我的工作簿中有一个主电子表格，我想通过附加新数据来保持最新状态（因此请继续将新电子表格的数据附加到下一个空行）。我想创建一个宏，可以采用导入的电子表格（例如电子表格 A）并查看列的标题值，复制列范围（从第 2 行开始到列内填充的末尾），转到电子表格 Master ，查找标题值，然后将列范围粘贴到列中向下的下一个空单元格中。此过程适用于电子表格 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.

例如）我有“主”表和“导入”表。我想获取“导入”表，查看第 1 行中的标题，从第 1 列开始。如果“主”表中存在该标题，请从“导入表”中复制该列（减去标题）并粘贴到“ master”在适当的列标题下，从该列中的下一个空单元格开始。我最终想要做的是保留带有历史数据的“主”表，但“导入”表包含移动的列，所以我无法复制和粘贴从主中的下一个空单元格开始的范围。

回答by Tim Williams

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

编辑：更新为仅复制具有任何内容的列，并且仅复制值

回答by RCoy1978

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

谢谢，瑞安