Фильтруйте, затем скопируйте и вставьте значения в новую вкладку Excel

Question

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

Макрос перестает работать с этой строкой кода.

Sheets(sht).Range("A1:A" & last).AdvancedFilter Action:=xlFilterCopy, _
  CopyToRange:=Range("CA1"), Unique:=True

---

Private Sub CommandButton3_Click()

Application.ScreenUpdating = False
Dim x As Range
Dim rng As Range
Dim last As Long
Dim sht As String

'specify sheet name in which the data is stored
sht = "data"

'change filter column in the following code
last = Sheets(sht).Cells(Rows.Count, "B").End(xlUp).Row
Set rng = Sheets(sht).Range("A1:AY" & last)
'set last column

Sheets(sht).Range("A1:A" & last).AdvancedFilter Action:=xlFilterCopy, _
  CopyToRange:=Range("CA1"), Unique:=True

For Each x In Range([CA2], Cells(Rows.Count, "CA").End(xlUp))
    With rng
        .AutoFilter
        .AutoFilter Field:=1, Criteria1:=x.Value
        .SpecialCells(xlCellTypeVisible).Copy

        Sheets.Add(After:=Sheets(Sheets.Count)).Name = x.Value
        ActiveSheet.Paste
        ActiveSheet.Range("A1").Select
        ActiveSheet.Columns("A:A").Select
        Selection.ColumnWidth = 15

    End With
Next x

' Turn off filter
Sheets(sht).AutoFilterMode = False

With Application
    .CutCopyMode = False
    .ScreenUpdating = True
End With

End Sub

Answer 1

По-моему, я думаю:

1. Вам не хватает End Sub в конце кода.
2. CopyToRange:=Range("CA1"), Вы не упоминаете название листа, только диапазон.

Answer 2

это работает !!

Private Sub CommandButton3_Click()

Application.ScreenUpdating = False
Dim x As Range
Dim rng As Range
Dim last As Long
Dim sht As String

'specify sheet name in which the data is stored
sht = "data"

'change filter column in the following code
last = Sheets(sht).Cells(Rows.Count, "B").End(xlUp).Row
Set rng = Sheets(sht).Range("A1:AY" & last)
'set last column

Sheets(sht).Range("A1:A" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("CA1"), Unique:=True


End Sub