macros从一张表中逐列复制并粘贴到主表中，以保持数据增长

我对Excel VBA相当陌生，一直在寻找（以及提出自己的）解决scheme来解决我面临的困境。 通常，我从同事那里收到原始数据文件，这些原始数据文件可能有不同数量的列，但是标题名称一致。 我在工作簿中有一个主电子表格，我想通过追加新数据来保持最新状态（所以请将新电子表格的数据添加到下一个空行）。 我想创build一个macros，可以导入电子表格（比如电子表格A），查看列的标题值，复制列范围（从第2行开始到列中填充结束），转到电子表格Master ，查找标题值，然后将列范围粘贴到列中下一个空白单元格中。 这个过程将用于电子表格A中的所有列。

任何帮助/指导/build议将非常感激。

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

Answer 1

未经testing，但编译好：

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 

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

Answer 2

我不能得到上面的工作，并需要与原来的问题相同的结果。 有什么想法缺less什么？ 我以为我改变了一切需要改变，以适应我的床单：

 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 

谢谢，瑞安