filtre avec vide et 1 seul critére a

Selection.AutoFilter
 ActiveSheet.Range("$A$1:$A$11").AutoFilter Field:=1, Criteria1:="="

Sub Copie_Structure_Feuille_Valeur_Format_Commentaire()
'Dim t1 As Long, NomFAct As String, DerCelSel As Variant, DerCelAdr As Variant, NBcol As Long, NBLig As Long, cell As Range, i As Long
    Dim LargCol(1048576), HautLig(1048576)    ', DercelLig As Long, DerCelCol As Long, Ilig As Long, ICOl As Long
 If [A1].SpecialCells(xlLastCell).Address = "$A$1" And [A1] = "" Then Exit Sub
    t1 = Timer

    Application.ScreenUpdating = False
    NomFAct = ActiveSheet.Name


    'DerCelSel = ActiveCell.SpecialCells(xlLastCell).Select
    'DerCelAdr = ActiveCell.Address
    'DercelCol = ActiveCell.Column
    'DercelLig = ActiveCell.Row
    'Attenton si bug avec des feuille vide mais à la fin à 1 milllions de ligne.Voir avec les paramètres suivant:
    
   'If DercelLig > 1000 Then DercelLig = 65000
   'If DercelCol > 1000 Then DercelCol = 65000
   'MsgBox Cells.Find("*", [A1], , , 1, 2).Row
   DercelLig = Cells.Find("*", [A1], , , 1, 2).Row
   DercelCol = Cells.Find("*", [A1], , , 1, 2).Column
   
    NBcol = 0
    For ICOl = 1 To DercelCol
        If Cells(1, ICOl).ColumnWidth <> 0 Then NBcol = NBcol + 1: LargCol(NBcol) = Cells(1, ICOl).ColumnWidth
    Next
    
    
    NBLig = 0
    For Ilig = 1 To DercelLig
        If Rows(Ilig & ":" & Ilig).RowHeight <> 0 Then NBLig = NBLig + 1: HautLig(NBLig) = ActiveSheet.Rows(Ilig & ":" & Ilig).RowHeight
    Next
    'Stop
    ' A voir pour traitement de type Tableau
    'For Each cell In ActiveSheet.Range(Cells(1, 1), Cells(DercelLig, DerCelCol))
        'Traitement tableau
    'Next

    Sheets.Add
    For i = 1 To NBcol
        Cells(1, i).ColumnWidth = LargCol(i)
    Next
    For i = 1 To NBLig
        Rows(i & ":" & i).RowHeight = HautLig(i)
    Next

    ActiveSheet.Next.Select
    Range("A1").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    ActiveSheet.Previous.Select
    Range("A1").Select
    
    'Mettre pour chaque cellule la valeur et le format et le commentaire
    'Posibilité de mettre la formule avec xlPasteFormulas mais commenter xlPasteValues
    'Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
     SkipBlanks:=False, Transpose:=False
     
     'Copie la valeur
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                            SkipBlanks:=False, Transpose:=False
     'Copie le Format
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                            SkipBlanks:=False, Transpose:=False
    'Copie les Commentaires
    Selection.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
                            SkipBlanks:=False, Transpose:=False
                           On Error Resume Next 'au cas ou le nom de l'onglet existe
        If Len(NomFAct) < 27 Then ActiveSheet.Name = "CV " & Replace(NomFAct, " ", "") Else ActiveSheet.Name = "CV " & Replace(Mid(NomFAct, 1, 14), " ", "") & Replace(Right(NomFAct, 14), " ", "")
    
    Application.CutCopyMode = False
    Application.ScreenUpdating = True


    'MsgBox Timer - t1
    Application.StatusBar = Format(Timer - t1, "0.0") & " secondes"
End Sub

Sub Macro10()
Dim pf As Range
    With ActiveSheet
        .Range("$N$1:$Q$7").AutoFilter Field:=1, Criteria1:="<>"
        Set pf = .[_FilterDatabase]
         pf.Offset(1, 0).Resize(pf.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy Sheets("copie").Range("A1")
         .AutoFilterMode = False
    End With
End Sub