Excel VBA как скопировать отфильтрованный столбец, не зная диапазона

Question

Я хотел бы скопировать отфильтрованный столбец, не зная его диапазона и только используя имя заголовка.

Sub RecoverData()
Application.ScreenUpdating = False
Dim x As Workbook

'## Open both workbooks first:
Set x = Workbooks.Open(Application.ActiveWorkbook.Path & "\data.xlsx")

With x.Sheets("Feuil1").Rows(1)
    Range("A1").AutoFilter Field:=2, Criteria1:=Array("a*", "b"), Operator:=xlFilterValues
    Set t = .Find("Vendor name", lookat:=xlWhole)
    If Not t Is Nothing Then
        Columns(t.Column).EntireColumn.Copy _
        Destination:=ThisWorkbook.Sheets("Feuil2").Range("B1")
    Else: MsgBox "Column Name Not Found"
    End If
End With
x.Close
ThisWorkbook.Sheets("Feuil2").Range("A1").CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlYes
Application.ScreenUpdating = True
End Sub

На самом деле мой код выглядит следующим образом, но метод, который я использую для копированияколонка не работает из-за скрытых ячеек.Я старался быть максимально точным, скажи мне, если тебе все еще нужны подробности.Спасибо.

Answer 1

Спасибо DisplayName, я изменил только 2 или 3 вещи, и теперь это работает.Вот мой код, если кому-то нужен один день

Sub RecoverData()
Application.ScreenUpdating = False
Dim x As Workbook
Dim t As Range

'## Open both workbooks first:
Set x = Workbooks.Open(Application.ActiveWorkbook.Path & "\data.xlsx")

With x.Sheets("Feuil1") ' reference source sheet
    Set t = .Rows(1).Find("Vendor name", lookat:=xlWhole) ' try searching wanted header in referenced sheet first row
    If Not t Is Nothing Then ' if found
        Range(t.Address).AutoFilter Field:=2, Criteria1:=Array("a*", "b*"), Operator:=xlFilterValues
        Intersect(.UsedRange, t.EntireColumn).SpecialCells(xlCellTypeVisible).Copy _
        Destination:=ThisWorkbook.Sheets("Feuil2").Range("A1") '<<== paste filtered column to destination sheet A1 cell (instead of B1), to match your subsequent removeduplicates call
        ThisWorkbook.Sheets("Feuil2").Range("A1").CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlYes
        .AutoFilterMode = False
    Else
        MsgBox "Column Name Not Found"
    End If
End With
x.Close savechanges:=False
Application.ScreenUpdating = True
End Sub

Answer 2

вы можете попробовать это:

Sub RecoverData()
    Application.ScreenUpdating = False
    Dim x As Workbook
    Dim t As Range

    '## Open both workbooks first:
    Set x = Workbooks.Open(Application.ActiveWorkbook.Path & "\data.xlsx")

    With x.Sheets("Feuil1") ' reference source sheet
        Set t = .Rows(1).Find("Vendor name", lookat:=xlWhole) ' try searching wanted header in referenced sheet first row
        If Not t Is Nothing Then ' if found
            .Rows(1).AutoFilter Field:=t.column, Criteria1:=Array("a*", "b"), Operator:=xlFilterValues ' filter data
            Intersect(.UsedRange, t.EntireColumn).SpecialCells(xlCellTypeVisible).Copy _
            Destination:=ThisWorkbook.Sheets("Feuil2").Range("A1") '<<== paste filtered column to destination sheet A1 cell (instead of B1), to match your subsequent removeduplicates call
            ThisWorkbook.Sheets("Feuil2").Range("A1").CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlYes
            .AutoFilterMode = False
        Else
            MsgBox "Column Name Not Found"
        End If
    End With
    x.Close

    Application.ScreenUpdating = True
End Sub