Question

我需要Excel VBA代码，该代码将自动搜索源工作簿中的所有列，然后遍历每个列名，然后复制每个列中的所有值，并将所有值粘贴到同一列名下的另一个工作簿中（这样做之后也是如此）自动搜索目标工作簿中的所有列。

我已经通过指定每一列来编写用于复制和粘贴值的代码，但是我需要本质上是动态的并且可以在所有不同的excel工作表上运行的代码。

Sub CopyCurrentRegion()
    Dim lastrow As Long
    lastrow = Workbooks("Benchmark to Edit.xlsx").Worksheets("ANNEX A-1").cells(Rows.count, 2).End(xlUp).Row
    Workbooks("Benchmark to Edit.xlsx").Worksheets("ANNEX A-1").Range("B7:B7" & lastrow).Copy
    Workbooks("Master to Edit.xlsb").Worksheets("IP Tape").Range("B9").PasteSpecial Paste:=xlPasteValues

    Workbooks("Benchmark to Edit.xlsx").Worksheets("ANNEX A-1").Range("C7:C7" & lastrow).Copy
    Workbooks("Master to Edit.xlsb").Worksheets("IP Tape").Range("F9").PasteSpecial Paste:=xlPasteValues
End sub

Answer 1

您可以提取硬编码的工作表名称（包括其父项），然后以工作表为参数调用Sub。

Sub testCopyCurrentRegion()
    Call CopyCurrentRegion(Workbooks("Benchmark to Edit.xlsx").Worksheets("ANNEX A-1"), _
        Workbooks("Master to Edit.xlsb").Worksheets("IP Tape"))
End Sub


Sub CopyCurrentRegion(ws_source As Worksheet, ws_target As Worksheet)
    Dim lastrow As Long

    lastrow = ws_source.Cells(Rows.Count, 2).End(xlUp).Row
    ws_source.Range("B7:B7" & lastrow).Copy
    ws_target.Range("B9").PasteSpecial Paste:=xlPasteValues

    ws_source.Range("C7:C7" & lastrow).Copy
    ws_target.Range("F9").PasteSpecial Paste:=xlPasteValues
End Sub

自动搜索所有列

1 个答案: