VBA Excel - Copying Filtered Cells

Question

I use the following code to copy filtered cells to another sheet. It doesn't copy anything though.

' Imposta il foglio di lavoro originale
Set ws = ThisWorkbook.Sheets("Clustered Info")

' Trova l'ultima riga con dati nella colonna A del foglio di origine
ultimaRiga = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

' Crea un nuovo foglio di lavoro come destinazione
Set wsCopy = Sheets.Add(After:=Sheets(Sheets.Count))
wsCopy.Name = "Clustered Info to Upload"

' Definisci un array di valori per il filtro nella colonna M
'elimino DS e DS De-SCoped
criteriFiltro = Array("DS", "DS De-scoped")

' Applica il filtro alla colonna B
ws.Range("M1").AutoFilter Field:=1, Criteria1:=criteriFiltro, Operator:=xlFilterValues


' Copia i dati filtrati dalla colonna A alla colonna L nella nuova destinazione
ws.Range("A1:L" & ultimaRiga).SpecialCells(xlCellTypeVisible).Copy Destination:=wsCopy.Range("A1")


' Rimuovi il filtro
ws.AutoFilterMode = False

Answer 1

Copy Adjacent Columns of a Filtered Table Range to a New Sheet

Sub CopyFilteredTable()

    ' Define constants.

    Const DST_SHEET_NAME As String = "Clustered Info to Upload"
    Dim Arr() As Variant: Arr = Array("DS", "DS De-scoped")
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Application.ScreenUpdating = False
    
    ' Source
    
    ' Reference the source range.
    Dim sws As Worksheet: Set sws = wb.Sheets("Clustered Info")
    sws.AutoFilterMode = False
    Dim srg As Range: Set srg = sws.Range("A1").CurrentRegion
    
    ' Filter.
    srg.AutoFilter Field:=13, Criteria1:=Arr, Operator:=xlFilterValues
    
    ' Reference the filtered cells in the given columns.
    Dim svrg As Range: Set svrg = srg.SpecialCells(xlCellTypeVisible)
    If svrg.Rows.Count = 1 Then ' only headers visible
        MsgBox "No filtered cells found.", vbExclamation
        Exit Sub
    End If
    Set svrg = Intersect(svrg, sws.Columns("A:L"))
    sws.AutoFilterMode = False
    
    ' Destination
    
    ' Check if the destination sheet exists.
    Dim dsh As Object:
    On Error Resume Next ' prevent error when sheet doesn't exist
        Set dsh = wb.Sheets(DST_SHEET_NAME)
    On Error GoTo 0

    ' Delete the destination sheet (if it existed).
    If Not dsh Is Nothing Then ' sheet exists
        Application.DisplayAlerts = False ' delete without confirmation
            dsh.Delete
        Application.DisplayAlerts = True
    End If
    
    ' Add a new sheet, rename it and reference its first cell.
    Dim dws As Worksheet:
    Set dws = wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count))
    dws.Name = DST_SHEET_NAME
    Dim dfcell As Range: Set dfcell = dws.Range("A1")
    
    ' Copy.
    
    svrg.Copy dfcell
    
    Application.ScreenUpdating = True
    
    ' Inform
    
    MsgBox "Filtered table copied to new worksheet.", vbInformation

End Sub