Error 1004: Método 'Range' del objeto '_Worksheet' falló

Hola a todos,

Les contacto porque llevo un día atascado con este problema.

Al ejecutar la macro, me encuentro con el error mencionado en el título en la línea 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) 'Apertura del archivo Set classeurDestination = ThisWorkbook With Worksheets("Materiels") If .FilterMode = True Then .ShowAllData 'Eliminación de los filtros existentes End With classeurProj.Sheets("Materiels").Cells.Copy classeurDestination.Sheets(Extraction).Range("A1") 'Extracción de la información en su hoja específica classeurProj.Close False 'Eliminación de duplicados sin pérdida de información 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 'lugar del error 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")) ' nombre+apellido 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

Preciso varios puntos:
- La primera parte (apertura y extracción) funciona muy bien (ver la publicación "Inserción de ventana de selección en una macro")
- La segunda parte (eliminación de duplicados) funciona sin problemas cuando el error no bloquea la macro. Así que no propongan mejoras, por favor.
- La información en las líneas 22 y 23 (

Extraction

y

Résumé

) corresponde exactamente a la búsqueda solicitada.
- La línea 19 no tiene ningún impacto en la segunda parte.
- La macro está vinculada a carpetas confidenciales, no puedo poner mi macro en línea.

¿Alguien puede ayudarme?

Gracias de antemano.

--
Dos cerebros son mejor que uno.