Probléme de filtre sur VBA

Bonjour, je fais appelle à une âme charitable pour m'aider sur une macro

J'ai deux fichier, un fichier dans lequel j'ai un bouton "insérer PFC" et un autre fichier qui s'appelle PFC, l'objectif de la macro est d'aller chercher le fichier PFC et copier des valeurs selon un filtre sur l'année

Le problème est que des fois la macro marche parfaitement et des fois ça ne marche pas du tout, je n'ai jamais compris pourquoi, ça bloque au niveau du filtre,

peut être qu'il y a quelque chose dans le code qui décorne et que je ne vois pas

fichier de départ "Vérif D_OPTEAM" feuille "2021"

fichier cible "PFC"

la macro c'est PFC_2021() dans le module PFC

Voici le code

Sub PFC_2021()

On Error GoTo FinMacro
Application.ScreenUpdating = False

Dim classeur As String

Set classeur_source = ActiveWorkbook
Set feuille_source = classeur_source.Sheets(1)

classeur = Application.GetOpenFilename

Set classeur_cible = Workbooks.Open(classeur)
Set feuille_cible = classeur_cible.Sheets(1)
Y = feuille_cible.Cells(Rows.Count, 1).End(xlUp).Row

Range("D1").Select
ActiveCell.FormulaR1C1 = "ANNEE"
Range("D2").Select
ActiveCell.FormulaR1C1 = "=YEAR(RC[-3])"
Range("D2").Select
With feuille_cible
.Range("D2:" & "D" & Y).Formula = "=YEAR(RC[-3])"
End With
Columns("D:D").Select
Range("D2:" & "D" & Y).AutoFilter Field:=4, Criteria1:="2021"
Ligdeb = ActiveCell.Row

Range("C" & Ligdeb).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Application.WindowState = xlNormal

classeur_source.Activate
feuille_source.Activate

Range("E2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

classeur_cible.Activate
Columns("D:D").Select
Selection.Delete Shift:=xlToLeft
classeur_cible.Close False

PFC_insere.Show

FinMacro:
Application.ScreenUpdating = True

End Sub

Bonjour,

Voici le code optimisé il faut penser à définir les variables et utiliser les objet conteneur

Sub PFC_2021()
  Dim WbkC As Workbook  ' Classeur cible
  Dim ShtC As Worksheet ' Feuille Cible
  Dim ShtS As Worksheet ' Feuille source
  Dim dLigC As Long ' Dernière ligne remplie de la feuille cible
  Dim LigDebC As Long
  Dim sAnnée As String
  Dim Classeur As String

  On Error GoTo FinMacro
  Application.ScreenUpdating = False
  sAnnée = "2021"
  Set ShtS = ActiveWorkbook.Sheets(sAnnée)
  ' Aller chercher le fichier
  Classeur = Application.GetOpenFilename
  Set WbkC = Workbooks.Open(Classeur)
  Set ShtC = WbkC.Sheets(1)
  ' Dernière ligne remplie de la feuille cible
  dLigC = ShtC.Cells(Rows.Count, 1).End(xlUp).Row
  ' On filtre les lignes juste sur l'année
  ShtC.Range("A1:C" & dLigC).AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(0, "12/31/" & sAnnée)
  ' 1ère ligne visible des lignes filtrées
  LigDebC = [_filterdatabase].Offset(1).Resize(, 1).Row
  ShtC.Range(ShtC.Range("C" & LigDebC), ShtC.Range("C" & LigDebC).End(xlDown)).SpecialCells(xlCellTypeVisible).Copy
  ' Collage spécial dans le classeur source
  ShtS.Range("E2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  ' On ferme le classeur cible
  WbkC.Close SaveChanges:=False
  ' Effacer les variables objet pour libérer la mémoire
  Set ShtC = Nothing: Set WbkC = Nothing: Set ShtS = Nothing
  ' Afficher l'USF
  PFC_insere.Show

FinMacro:
  Application.ScreenUpdating = True
End Sub

@+