Блог

Я хочу скопировать несколько столбцов с листа с именем «Данные» и создать новый лист для вставки этих столбцов.

Я получаю

ошибка времени выполнения «438» объект не поддерживает это свойство или метод.

в строке

 For Each xlcell In .myRng.Cells ' look through each cell in your header 
 

Мой полный код.

 Sub extractcols()

    Dim myCollection    As Collection
    Dim myIterator      As Variant
    Dim myRng           As Range
    Dim xlcell          As Variant
    Dim ws              As Worksheet
    Dim wsh             As Worksheet
    Dim colCounter      As Integer
    
    Dim lCol As Long, i As Long

    Set ws = ActiveWorkbook.Worksheets("Data")
    Set myCollection = New Collection

    'Create a collection of header names to search through
    myCollection.Add ("1")
    myCollection.Add ("2")
    myCollection.Add ("3")
    
    'Add worksheet
    With ThisWorkbook
 
        .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "Main"
 
        Set wsh = ActiveWorkbook.Worksheets("Main")
    
        'Where to search, this is the header
        With ThisWorkbook.Sheets("Data")
            lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    
            colCounter = 0
            For Each xlcell In .myRng.Cells ' look through each cell in your header
                For Each myIterator In myCollection ' look in each item in the collection
                    If myIterator = xlcell.Value Then ' when the header matches what you are looking for
                        colCounter = colCounter   1 ' creating a column index for the new workbook
                        ws.Columns(xlcell.Column).Copy
                        wsh.Columns(colCounter).Select
                        wsh.Paste
                    End If
                Next
            Next
        End With
    End With
End Sub
 

Я определил заголовки столбцов или имена столбцов, которые я хочу скопировать из листа «Данные», как MyCollection.Add.

Я хочу скопировать эти указанные столбцы с листа с именем «Данные», затем создать новый лист с именем «Main» и вставить эти столбцы в новый лист.

Во-первых, myRng он только объявлен, а не определен. Попробуйте настроить его следующим образом:

 Set myRng = .range("A1", .cells(1, lCol))
 

Затем используйте его как:

 For Each xlcell In myRng.Cells 'without dot (.) in front of it
 

Нет необходимости в каком-либо выборе для копирования диапазона. В этой ситуации он использует только ресурсы Excel. На самом деле, эта часть вашего кода должна выглядеть следующим образом:

 'your existing code
'...
    lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    Set myRng = .range("A1", .cells(1, lCol))    
    colCounter = 0
    For Each xlcell In myRng.Cells ' look through each cell in your header
        For Each myIterator In myCollection ' look in each item in the collection
            If myIterator = xlcell.Value Then ' when the header matches what you are looking for
                colCounter = colCounter   1 ' creating a column index for the new workbook
                ws.Columns(xlcell.Column).Copy wsh.Columns(colCounter) 'if you want pasting in the incremented column number...
            End If
        Next
    Next
'...
'your existing code...