Erreur 1004 : Méthode 'Range' de l'objet '_Worksheet' a échoué [Résolu]

Signaler
Messages postés
15
Date d'inscription
lundi 12 octobre 2020
Statut
Membre
Dernière intervention
26 novembre 2020
-
Messages postés
15
Date d'inscription
lundi 12 octobre 2020
Statut
Membre
Dernière intervention
26 novembre 2020
-
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.

3 réponses

Messages postés
979
Date d'inscription
lundi 22 septembre 2008
Statut
Membre
Dernière intervention
10 janvier 2021
199
Bonjour
Teste en changeant la ligne 24
Range(F2.Range("A3"), F2.Range("AA6000")).ClearContents


par

F2.Range(Cells(3,"A"),cells(6000,"AA")).ClearContents 
Messages postés
15
Date d'inscription
lundi 12 octobre 2020
Statut
Membre
Dernière intervention
26 novembre 2020

Bonjour,

Déjà essayé mais toujours bloqué.

J'ai réessayé dans le doute mais ça n'a rien changé.
Messages postés
979
Date d'inscription
lundi 22 septembre 2008
Statut
Membre
Dernière intervention
10 janvier 2021
199
Re,
Remplace tes " Extraction As String, Résumé As String"
en "As Worksheet"
Messages postés
15
Date d'inscription
lundi 12 octobre 2020
Statut
Membre
Dernière intervention
26 novembre 2020

Ca ne marche pas car ils sont utilisés au début aux lignes 8 et 9, et également liés à ma sélection de départ.
Messages postés
7210
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
18 janvier 2021
601
Bonjour,

comme ceci:

F2.Range("A3:AA6000").ClearContents  


Messages postés
15
Date d'inscription
lundi 12 octobre 2020
Statut
Membre
Dernière intervention
26 novembre 2020

Bonjour,

En effet, c'est la solution.
Je ne sais pas pourquoi j'ai écrit de cette manière alors qu'il s'agit de la même feuille.

Encore Merci, cs_Le Pivert