VBA - Erreur d’exécution 1004

Bonjour,

J'utilise un code similaire sur ce même fichier Excel, mais à un onglet différent et avec un Bouton de Macro différent

Ceci pour aller extraire des infos dans un fichier source

La Macro précédente marche très bien, par contre ici je me retrouve avec une Erreur 1004

Je m'arrache les quelques cheveux qu'il me reste, en attendant qu'un œil neuf et averti vienne à mon secours

Le code ci-dessous :

Option Explicit

Sub EXTRACT_X_DRCL_OVERVIEW()

Dim cells As Range
Dim DerLig As Long, DLig As Long
Dim Wb As Workbook
Dim Wss As Worksheet, Ws As Worksheet
Dim chemin As String, fichier As String, Onglet2 As String

Application.ScreenUpdating = False
Range("A10:M50").ClearContents 'Selection du tableau "zone de données" et effacement des données initiales
DerLig = 10 'A partir de la ligne 10 du tableau Extract X-DRCL OVERVIEW
Set Ws = ThisWorkbook.ActiveSheet
chemin = Range("D3").Value 'Fait référence ici à la cellule D3 du chemin complet vers le fichier source
chemin = chemin & "\" 'Ajoute à ce chemin un "\" pour terminer le bon chemin
Onglet2 = Range("K2").Value 'Fait référence ici à la cellule K2 pour l'onglet ciblé du fichier source
fichier = Dir(chemin & "*.xls") 'Cherche le fichier Excel en .xls

Do While fichier <> ""
Set Wb = Workbooks.Open(Filename:=chemin & fichier)
Set Wss = Wb.Sheets(Onglet2)

DLig = Wss.cells(Rows.Count, 1).End(xlUp).Row
Ws.cells(DerLig, 1).Resize(DLig - 1, 13).Value = Wss.Range("$A$8:$M$" & DLig).Value '*** 'Erreur d’exécution' 1004 ' : erreur définie par l’application ou par l’objet

Wb.Close False
Application.CutCopyMode = False
DerLig = Ws.cells(Rows.Count, 1).End(xlUp).Row + 1
fichier = Dir ' Fichier suivant
Loop

End Sub

bonjour,

vérifie les valeur de Dlig et Derlig, (je soupçonne de Dlig ait la valeur 1), difficile de t'aider davantage sans ton fichier.

Re-Bonjour h2so4 ^^

Je viens de vérifier

Derlig = 10

Dlig = 0

C'est un casse tète cette histoire

Rebonjour,

dlig=0 cela me parait peu probable. dlig-1=0 ok. Sinon, je répète si tu veux de l'aide merci de mettre tes fichiers.

Désolé pour le temps de réponse, j'ai allégé les 2 fichiers (source et cible) pour les lier ici

J'ai vérifié et cela reproduit bien la même erreur 1004

8sdr-clim.xlsx (237.29 Ko)

bonsoir,

je ne parviens pas à reproduire le problème chez moi. tout fonctionne correctement.

Bonjour h2so4,

Je viens de retester et ca me le fait encore, c'est à ni rien comprendre

La seule fois ou ca a marché, en adaptant un nouveau code, c'est quand j'ai copié et coller mon fichier source (pour un Draft) dans un onglet de mon fichier cible

Ce qui veut dire que le fichier source : ca va

Faudrait peut être que je revoie ce code en entier pour l'adapter à un nouveau et plus spécifique à "EXTRACT_X_DRCL_OVERVIEW_TEST"

Mais je voie pas trop comment

Je viens d'essayer via un nouveau code , mais j'ai un problème de Range => La méthode range de l'objet worksheet a échoué

et lors de l'exécution pas à pas, il ne m'affiche pas le bon onglet du fichier source

Option Explicit

Sub EXTRACT_X_DRCL_2303()

Dim iLig As Integer, piLigDeb As Integer, piLigFin As Integer
Dim cells As Range
Dim DLig As Long, DerLig As Long
Dim Wb As Workbook
Dim Wss As Worksheet, Ws As Worksheet
Dim chemin As String, fichier As String, Onglet As String, fich As String, i As String

Application.ScreenUpdating = False
Range("A10:M46").ClearContents
DerLig = 10
Set Ws = Worksheets("EXTRACT X-DRCL OVERVIEW")

chemin = Range("D3").Value 'Fait référence ici à la cellule D3 du chemin complet du dossier où se trouvent le fichier source de la DR1
chemin = chemin & "\" 'Ajoute à ce chemin un "\" pour terminer le bon chemin
Onglet = Range("K2").Value 'Fait référence ici à la cellule K2 pour l'onglet ciblé du fichier source

i = InStr(1, StrReverse(chemin), "\", vbTextCompare)
If i <> 0 Then
fich = Left(chemin, Len(chemin) - i) 'Ajoute un "\" si besoin ou pas
End If

fichier = Dir(chemin & "*.xls")
Do While fichier <> ""
Set Wb = Workbooks.Open(Filename:=chemin & fichier)
Set Wss = Wb.Sheets(Onglet)
DLig = Wss.cells(Rows.Count, 1).End(xlUp).Row

Set Wss = Worksheets(Onglet)
Application.ScreenUpdating = False
For iLig = piLigDeb To piLigFin

'En colonne "A" de "EXTRACT X-DRCL OVERVIEW" = je veux ce qu'il y a en colonne "A" de la "XDRCL OVERVIEW"
Ws.Range("A" & DerLig).Value = Wss.Range("A" & iLig).Value '=> : La méthode range de l'objet worksheet a échoué
Ws.Range("B" & DerLig).Value = Wss.Range("B" & iLig).Value
Ws.Range("C" & DerLig).Value = Wss.Range("C" & iLig).Valuer
Ws.Range("D" & DerLig).Value = Wss.Range("D" & iLig).Value
Ws.Range("E" & DerLig).Value = Wss.Range("E" & iLig).Value
Ws.Range("F" & DerLig).Value = Wss.Range("F" & iLig).Value
Ws.Range("G" & DerLig).Value = Wss.Range("G" & iLig).Value
Ws.Range("H" & DerLig).Value = Wss.Range("H" & iLig).Value
Ws.Range("I" & DerLig).Value = Wss.Range("I" & iLig).Value
Ws.Range("J" & DerLig).Value = Wss.Range("J" & iLig).Value
Ws.Range("K" & DerLig).Value = Wss.Range("K" & iLig).Value
Ws.Range("L" & DerLig).Value = Wss.Range("L" & iLig).Value
Ws.Range("M" & DerLig).Value = Wss.Range("M" & iLig).Value

DerLig = DerLig + 1
Next iLig
Loop
Application.ScreenUpdating = True
Set Wss = Nothing
End Sub

Bonjour Bernard, Salut h2so4 !

Bernard, pour poster du code, vous pouvez utiliser les balises </> du ruban d'icônes , ça facilite la lecture et la copie.

Je pense en général qu'il ne faut pas utiliser plus de variables que nécessaire : Il y a une boucle sur iLig qui va de piLigDeb à piLigFin. Or, piLigDeb n'est pas initialisée (sauf erreur de ma part).

Voici une proposition de réorganisation de votre premier code (je l'avais faite hier en fait) :

Sub EXTRACT()

dim t
Dim nvl&, dl&
Dim chemin As String, fichier As String, Onglet2 As String

Application.ScreenUpdating = False
with ThisWorkbook.ActiveSheet
    .Range("A10:M50").ClearContents 'Selection du tableau "zone de données" et effacement des données initiales
    chemin = .Range("D3").Value & "\" 'Fait référence ici à la cellule D3 du chemin complet vers le fichier source
    Onglet2 = .Range("K2").Value 'Fait référence ici à la cellule K2 pour l'onglet ciblé du fichier source
    fichier = Dir(chemin & "*.xls*") 'Cherche le fichier Excel en .xls
    Do While fichier <> ""
        with Workbooks.Open(chemin & fichier)
            with .Sheets(Onglet2)
                dl = application.max(.cells(.Rows.Count, 1).End(xlUp).Row, 8)
                t = .Range("A8:M" & dl).Value
            end with
            .Close true
        end with
        nvl = .cells(.Rows.Count, 1).End(xlUp).Row + 1
        .cells(nvl, 1).Resize(ubound(t), ubound(t, 2)).Value = t
        fichier = Dir ' Fichier suivant
    Loop
end with
application.screenupdating = true

End Sub

Par ailleurs, en cas de boucle while reposant sur la fonction Dir, il ne faut pas oublier la ligne fichier = dir avant le loop.

Cdlt,

bonjour,

piligdeb et piligfin ne sont pas initialisés et par défaut ont la valeur 0

tu as une répétition de set wss (la deuxième ne fonctionne correctement que si le classeur WB est actif (ce qui est normalement le cas)

tu as un valuer qui traine (au lien de value)

Bonjour 3GB et h2so4 et merci pour votre aide

3GB,

Je viens de tester ton code et seule la ligne 8 du fichier source apparait, ce qui est déjà un très bon début

correspondant à :

                t = .Range("A8:M" & dl).Value

Hors je souhaiterai avoir toutes les info de la ligne 8 jusqu'à la ligne 40, y compris les lignes vides s'il y en a

Une idée ?

PS : En effet avec </> c'est plus pratique

h2so4,

Je vais laisser mon 2 code pour avancer sur la proposition de 3GB qui est de beaucoup plus propre

Re Bernard,

Sur le code, je demande sur la ligne juste avant que dl soit affectée du max entre le résultat de la méthode end et la ligne 8. Donc, cela signifie que la dernière cellule vide en colonne 1 se trouve avant la ligne 8.

Il faut appliquer la méthode end sur une autre colonne (par exemple la colonne 2) qui ait des valeurs jusqu'à la ligne 40 :

dl = application.max(.cells(.Rows.Count, 2).End(xlUp).Row, 8)

Edit : Sinon, si il faut toujours récupérer la même plage (A8:M40), on se passe de la variable dl et on met ceci :

            with .Sheets(Onglet2)
                'dl = application.max(.cells(.Rows.Count, 1).End(xlUp).Row, 8)
                t = .Range("A8:M40").Value 'si toujours jusqu'à ligne 40
            end with

Cdlt,

Trop bien ca me va très bien comme ca

Merci à vous 2 pour votre aide et votre support d'expert

Sujet clos pour moi

Rechercher des sujets similaires à "vba erreur execution 1004"