XL 2013 [Résolu] VBA-copier cellules sous condition d'une autre cellule

Sub copie_B()
Dim t, lig&, lig2&, f As Worksheet
t = Feuil2.[A1].CurrentRegion
Set f = Feuil3
lig = f.Cells(Rows.Count, 1).End(3).Row
f.Cells(lig + 1, 1).Resize(UBound(t, 1), UBound(t, 2)) = t
lig2 = f.Cells(Rows.Count, 1).End(3).Row
f.Range(Cells(lig + 2, "G"), Cells(lig2, "G")).FormulaR1C1 = "=IF(COUNTA(RC[-6]:RC[-1])=6,""$"",0)"
f.Columns("G:G").SpecialCells(xlCellTypeFormulas, 1).EntireRow.Delete
f.Columns("G:G").Clear
End Sub

Sub copie()
    Application.ScreenUpdating = False
    Sheets("Resultat").Cells.Clear
    With Sheets("Source")
        If .AutoFilterMode Then .ShowAllData
        .UsedRange.AutoFilter Field:=3, Criteria1:="<>"
        .UsedRange.SpecialCells(xlCellTypeVisible).Copy Sheets("Resultat").[a2]
        .AutoFilterMode = False
    End With
End Sub

Sub copie2()
Dim f As Worksheet: Set f = Feuil3
Application.ScreenUpdating = False
    With Sheets("Source")
        If .AutoFilterMode Then .ShowAllData
        .UsedRange.AutoFilter Field:=3, Criteria1:="<>"
        .AutoFilter.Range.Offset(1).Copy f.Cells(Rows.Count, 1).End(3)(2)
        .AutoFilterMode = False
    End With
End Sub

Sub copie()
    Dim Sh As Worksheet, Derlg&, Col&
    Application.ScreenUpdating = False
    For Each Sh In Sheets(Array("Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Août", "Septembre", "Octobre", "Novembre", "Décembre"))
        Sh.Cells.Clear
        If IsNumeric(Application.Match(Sh.Name, Feuil1.[1:1], 0)) Then
            Col = Application.Match(Sh.Name, Feuil1.[1:1], 0)
            With Feuil1
                Derlg = .Cells(.Rows.Count, "A").End(xlUp).Row
                .Range("a3:b" & Derlg).Copy Sh.[a2]
                .Range("g3:g" & Derlg).Copy Sh.[c2]
                .Range(.Cells(2, Col), .Cells(Derlg, Col + 3)).Copy
            End With
            Sh.[d1].PasteSpecial Paste:=xlPasteValues
            Sh.[d1].PasteSpecial Paste:=xlPasteFormats
            Sh.Columns.AutoFit
        End If
    Next
End Sub