Как динамически изменить столбец для фильтрации?

Question

Мне нужно создать копии целых рабочих книг (поскольку есть другие листы, форматирование и т. Д., Которые я хочу сохранить), а затем удалить строки данных, которые не равны текущему значению cl.value. Заголовки столбцов всегда будут находиться в строке 1. Рабочий лист может иметь различное количество столбцов (например, A: D, A: F, A: G и т. Д.), И конечный пользователь может выбрать любой столбец для разделения.

Ссылка на ячейку работает, но если попытаться сделать ее динамической (на основе выбора пользователя, упомянутого выше) в следующей части кода:

Workbooks.Open Filename:=FName
            'Delete Rows
            'REFERENCING ACTUAL CELL WORKS
            'Range("A1").AutoFilter 1, "<>" & cl.Value
            'BELOW DOES NOT WORK
            Range(ColHead).AutoFilter 1, "<>" & cl.Value

Я получаю

Ошибка времени выполнения '1004': метод 'Range' объекта'_Global 'Сбой

Полный код ниже:

Sub DisplayUserFormSplitWb()
UserFormSplitWb.Show
End Sub

Private Sub BtnOK_Click()
Call SplitWbMaster.SplitWbToFiles
End Sub

Private Sub UserForm_Initialize()
Dim SplitOptions As Range
Set SplitOptions = ActiveSheet.Range("A1", ActiveSheet.Range("A1").End(xlToRight))
SplitWbCol.List = Application.Transpose(SplitOptions.Value)
End Sub

Sub SplitWbToFiles()
   Dim cl As Range
   Dim OrigWs As Worksheet
   Dim Subtitle As String
   Dim ColValue As String
   Dim ColStr As String
   Dim ColNum As Long

   Set OrigWs = ActiveSheet

   ColValue = UserFormSplitWb.SplitWbCol.Value

   Set ColHead = Rows(1).Find(What:=ColValue, LookAt:=xlWhole)
   Set OffCol = ColHead.Offset(1, 0)
   ColStr = Split(ColHead.Address, "$")(1)
   ColNum = ColHead.Column
   If OrigWs.FilterMode Then OrigWs.ShowAllData
   With CreateObject("scripting.dictionary")
      For Each cl In OrigWs.Range(OffCol, OrigWs.Range(ColStr & Rows.Count).End(xlUp))
         If Not .exists(cl.Value) Then
            .Add cl.Value, Nothing
            'Turn off screen and alerts
            Application.ScreenUpdating = False
            Application.DisplayAlerts = False
            'Create workbook copy
            FPath = "U:\"
            Subtitle = UserFormSplitWb.SplitWbSubtitle.Value
            FName = FPath & cl.Value & "_" & Subtitle & ".xlsx"
            ActiveWorkbook.SaveCopyAs Filename:=FName
            Workbooks.Open Filename:=FName
            'Delete Rows
            'REFERENCING ACTUAL CELL WORKS
            'Range("A1").AutoFilter 1, "<>" & cl.Value
            'BELOW DOES NOT WORK
            Range(ColHead).AutoFilter 1, "<>" & cl.Value

            ActiveSheet.ListObjects(1).DataBodyRange.Delete

             Range(ColHead).AutoFilter
             Range(ColHead).AutoFilter
            'Rename sheet
            ActiveSheet.Name = Left(cl.Value, 31)
            'Refresh save and close
            ActiveWorkbook.RefreshAll
            ActiveWorkbook.Save
            ActiveWorkbook.Close False
         End If
      Next cl
   End With
   Application.ScreenUpdating = True
   Application.DisplayAlerts = True
   MsgBox "Splitting is complete. Please check your Computer (U:) drive.", vbOKOnly, "Run Macro"
End Sub

Answer 1

Всем, кто может наткнуться на этот вопрос -

Я обнаружил, что использование приведенного ниже кода решает мою проблему:

ActiveSheet.Range("A1", ActiveSheet.Range("A1").End(xlToRight)).AutoFilter ColNum, "<>" & cl.Value

где:

Dim ColNum As Long
ColNum = ColHead.Column