Автопоиск всех столбцов

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