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.
Déjà essayé mais toujours bloqué.
J'ai réessayé dans le doute mais ça n'a rien changé.