Erreur 1004 : Méthode 'Range' de l'objet '_Worksheet' a échoué

Bonjour à tous,

Je vous contacte car je bute sur ce problème depuis 1 journée.

Lors de l'exécution de la macro, je tombe sur l'erreur citée dans le titre sur la ligne 24.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Application.Intersect(Target, Range("G:G")) Is Nothing Then
Dim Chemin As String, Fichier As String, Extraction As String, Résumé As String
Dim classeurProj As Workbook, classeurDestination As Workbook
If Target.Value = "" Then Exit Sub
    Chemin = Range("b" & Target.Row)
    Fichier = Range("c" & Target.Row)
    Extraction = Range("d" & Target.Row)
    Résumé = Range("a" & Target.Row)
    Set classeurProj = Application.Workbooks.Open(Chemin & Fichier, , True) 'Ouverture du fichier
     Set classeurDestination = ThisWorkbook
    With Worksheets("Materiels")
        If .FilterMode = True Then .ShowAllData 'Suppression des filtres existants
    End With
    classeurProj.Sheets("Materiels").Cells.Copy classeurDestination.Sheets(Extraction).Range("A1") 'Extraction des informations dans sa feuille spécifique
    classeurProj.Close False
        
'Suppression des doublons sans perte d'information
    Worksheets("Bilan 2020").Select
        
    Set D1 = CreateObject("Scripting.Dictionary")
    Set F1 = Sheets(Extraction)
    Set F2 = Sheets(Résumé)
    Range(F2.Range("A3"), F2.Range("AA6000")).ClearContents       'lieu de l'erreur
    With F2
       If .FilterMode = True Then .ShowAllData
    End With
    F2.Columns("AA").NumberFormat = "0"
    
    ncol = F1.[a4].CurrentRegion.Columns.Count + 27
    nlig = F1.[a4].CurrentRegion.Rows.Count + 4
    D1.CompareMode = vbTextCompare
    For ligne = 1 To nlig
        clé = sansAccent(F1.Cells(ligne, "H")) & sansAccent(F1.Cells(ligne, "J"))   ' nom+prénom
        D1(clé) = ""
        ligT = Application.Match(clé, D1.keys, 0)
        For col = 1 To ncol
          If col = 3 Or col = 4 Then
            If F1.Cells(ligne, col) <> "" Then F2.Cells(ligT, col) = F1.Cells(ligne, col).Text
        Else
        If F1.Cells(ligne, col) <> "" Then
          If F2.Cells(ligT, col) <> "" Then
            If InStr(F2.Cells(ligT, col), F1.Cells(ligne, col)) = 0 Then
              F2.Cells(ligT, col) = F2.Cells(ligT, col) & Chr(10) & F1.Cells(ligne, col).Text
            End If
          Else
            F2.Cells(ligT, col) = F1.Cells(ligne, col).Text
          End If
        End If
      End If
     Next col
    Next ligne
   
End If

End Sub

Je précise plusieurs points:
- La première partie (ouverture et extraction) fonctionne très bien (voir le post "Insertion fenêtre de choix dans une macro")
- La deuxième partie (Suppression des doublons) marche sans souci quand l'erreur ne bloque pas la macro. Donc pas de proposition d'amélioration SVP.
- Les informations aux lignes 22 et 23 (

Extraction

et

Résumé

) correspondent exactement à la recherche demandée.
- La ligne 19 n'a aucun impact sur la deuxième partie.
- La macro étant lié à des dossiers confidentiels, je ne peux pas que mettre ma macro en ligne.

Est ce que quelqu'un peut m'aider ?

Merci d'avance.