Question

我对Excel VBA相当陌生，一直在努力寻找（以及提出我自己的）解决方案，以应对我所面临的困境。通常，我从同事那里收到原始数据文件，这些原始数据文件可能具有不同数量的列但是标题名称一致。我在我的工作簿中有一个主电子表格，我希望通过附加新数据来保持最新（因此请将新电子表格的数据附加到下一个空行）。我想创建一个宏，可以获取导入的电子表格（例如，电子表格A）并查看列的标题值，复制列范围（从第2行开始到列填充结束），转到电子表格主页，查找标题值，并将列范围粘贴到列中的下一个空单元格中。此过程适用于电子表格A中的所有列。

非常感谢任何帮助/指导/建议。

例）我有“主”表和“导入”表。我想获取“导入”表，从第1列开始查看第1行中的标题。如果该标题出现在“主”表中，请从“导入的表”复制列（减去标题）并粘贴到“掌握“在该列中下一个空单元格开始的相应列标题下。我最终想要做的是将“主”表格保留为历史数据，但“导入”表格包含可移动的列，因此我无法从主页中的下一个空单元格开始复制和粘贴范围。

Answer 1

未经测试但编译好了：

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

我无法完成上述工作，并且需要与原始问题相同的结果。对缺少什么的想法？我以为我改变了所有需要改变的东西以适应我的床单：

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

谢谢，莱恩

宏从一个工作表中逐列复制和粘贴到主工作表中，以保持增长的数据

2 个答案: