VBA Копировать целые столбцы на основе массива и вставлять их в лист в той же книге

Question

Используя Excel VBA, я пытаюсь скопировать определенные столбцы (в любом порядке), где, если заголовок совпадает со строками в массиве, эти столбцы копируются в целевой лист EmptyCells. На данный момент копируется только последний столбец в массиве, независимо от количества столбцов. Например:

1) HeaderName = Array ("Business Impact", "Typology") - копируется только типология

2) HeaderName = Array ("Business Impact", "Typology", ""ABCD ") - Только ABCD Скопировано

Можете ли вы помочь мне, пожалуйста.

"Я пытался использовать варианты Destination: = trg.Range (.......), но не могу понять это"

Sub Sup_DelCol()

    Dim i As Long, MaxColumns As Long
    Dim j As Long
    Dim HeaderName As Variant
    Dim src As Worksheet
    Dim trg As Worksheet
    Dim LastRow As Long

        '##Source Worksheet
    Set src = ThisWorkbook.Worksheets("general_report")

        '##Target Worksheet
    Set trg = ThisWorkbook.Sheets.Add(After:= _
    ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    trg.Name = "EmptyCells"


        'Column Names
    HeaderName = Array("Business Impact", "Typology")

        'Copy the columns where the header matches the strings in the array
    MaxColumns = src.UsedRange.Columns.Count

    For j = 0 To UBound(HeaderName, 1)
        For i = MaxColumns To 1 Step -1
            If src.Cells(1, i).Value = HeaderName(j) Then src.Cells(1, i).EntireColumn.Copy Destination:=trg.Range(.....)
    Next i
    Next j

      End Sub

Ожидаемый результат(На основе текущего массива):

Sheet EmptyCells (2 столбца) - влияние на бизнес (столбец A);Типология (столбец B)

Answer 1

Из того, что я могу понять из вашего кода, я думаю, что вы намеревались циклически проходить через .UsedRange.Cell вместо простого использования .Cell.

. Применение этих исправлений должно помочь. ,Измените этот код:

For j = 0 To UBound(HeaderName, 1)
     For i = MaxColumns To 1 Step -1
            If src.Cells(1, i).Value = HeaderName(j) Then src.Cells(1, i).EntireColumn.Copy Destination:=trg.Range(.....)
    Next i
Next j

На это (я удалил встроенный If для улучшения читабельности):

For j = 0 To UBound(HeaderName, 1)
     For i = MaxColumns To 1 Step -1
            If src.UsedRange.Cells(1, i).Value = HeaderName(j) Then
               src.UsedRange.Cells(1, i).EntireColumn.Copy _ 
               Destination:=trg.cells(1,columns.count).end(xltoleft).offset(,1)
            End If
    Next i
Next j

Примечание : я проверялэтот код в моем Excel, и теперь он эффективно перебирает все заголовки.

Редактировать

• Добавлен код @SJR для rng для полноты.

Надеюсь, это поможет.