Guru do Excel e Power BI

Sub Listar_Atraso()
Dim lr As Long
Dim sNomeAbreviado As String
Dim wb As Workbook
Dim ws As Worksheet
Dim fr As UserForm
'Limpar tabela destino
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name = "ATRASO" Then
            ws.Range("a1:AD" & ws.Rows.Count).Clear
        End If
    Next ws

' Limpa todos os filtros da planilha
If ActiveSheet.FilterMode Then
        
        ActiveSheet.ShowAllData
        
        End If

'Filtrar e selecionar atrasos
lr = Cells(Rows.Count, "A").End(xlUp).Row

With ThisWorkbook.Worksheets("ES0659")
    .Range("AD:AD").Delete
    [AD3].Value = "InsForm"
    .AutoFilterMode = False
    .Range("AD4").Formula = "=INT((TODAY()-S4+1))" 'Qual é a coluna de data?
    .Range("AD4").AutoFill Destination:=Range("AD4:AD" & lr)
    .Range("D3:AD3").AutoFilter
    .Range("D3:AD3").AutoFilter Field:=27, Criteria1:=">" & 1
sNomeAbreviado: UserForm1.Show 'InputBox("Selecione o Nome Abreviado STAUFF,TC SERVICOS,AQUANEX,WEG,FL,KIT NIVEL,WIKA LTDA,HAME,SHERWIN BNU")'
    If sNomeAbreviado = vbNullString Then
        MsgBox ("Busca cancelada")
        .AutoFilterMode = False
        .Range("AD:AD").Delete
        Exit Sub
    End If
    .Range("A3:AC3").AutoFilter Field:=12, Criteria1:=sNomeAbreviado
    .Range("A3:AC" & Cells(Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy Worksheets("ATRASO").Range("A1")
    'Set wb = Workbooks.Add'
    'ThisWorkbook.Sheets("ATRASO").Copy Before:=wb.Sheets(1)'
    'sNomeAbreviado = InputBox("Selecione o Nome Abreviado")'
   ' wb.SaveAs "C:\Users\HIN4PO\Desktop\FOLLOW UP\"'
    
End With

End Sub

Private Sub UserForm_Initialize()
ListBox1.RowSource = Range("O3:AO100").Address
End Sub