Problème "Erreur d'exécution 1004" => comment contourner ?

M

miliev83

XLDnaute Occasionnel
Bonsoir le forum,

Problématique du soir :
La macro suivante fonctionne lorsque mes données n'ont pas de caractères spéciaux ou plus de 31 caractères, ma question est donc comment faire pour contourner cela car cela concerne la moitié de mes données...

Code: 
Sub CreeClasseurs()
Dim Chemin$
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  [A1:z10000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[ab1], Unique:=True
  For Each C In Range("ab2", Range("ab65000").End(xlUp))
     Range("ab2") = C
     Sheets("Modèle").Select
     [A2:z100].Clear
     Sheets("Test").[A1:z10000].AdvancedFilter Action:=xlFilterCopy, _
         CriteriaRange:=Sheets("Test").[ab1:ab2], CopyToRange:=Sheets("Modèle").[A1:z1], Unique:=False
       ActiveSheet.Copy
       ActiveSheet.Name = C
       Chemin = "C:\Users\Jack\Desktop\test\test2\ABC\"
ActiveWorkbook.SaveAs Filename:=Chemin & C & ".xls", FileFormat:=xlExcel8
       ActiveWorkbook.Close
       Sheets("Test").Select
    Next C
End Sub

Merci à vous
 
Trier par date Trier par votes
Lone-wolf

Lone-wolf

XLDnaute Barbatruc
Re : Problème "Erreur d'exécution 1004" => comment contourner ?

Bonsoir miliev

À quelle feuille correspond [A1:z10000].AdvancedFilter + For Each C In Range("ab2", Range("ab65000").End(xlUp)) + Range("ab2") = C ?? :confused:

Si c'est Sheets("Modèle") alors:

Code: 
With Sheets("Modèle")
.Range("A1:z10000").AdvancedFilter
For Each C In .Range("ab2", .Range("ab65000").End(xlUp))
.Range("ab2") = C
Next C
.Range("A2:z100").ClearContents
End With
 
Dernière édition:
Vote positif 0 Vote négatif
M

miliev83

XLDnaute Occasionnel
Re : Problème "Erreur d'exécution 1004" => comment contourner ?

ça m'a l'air bon merci :)

une autre question, comment faire pour qu'en cas de doublon il n'écrase pas le fichier existant mais que le nouveau soit indicé comme cela par exemple "nomfichier_1" ?
 
Vote positif 0 Vote négatif
M

miliev83

XLDnaute Occasionnel
Re : Problème "Erreur d'exécution 1004" => comment contourner ?

Lone-wolf à dit:
Bonsoir miliev

À quelle feuille correspond [A1:z10000].AdvancedFilter + For Each C In Range("ab2", Range("ab65000").End(xlUp)) + Range("ab2") = C ?? :confused:

Si c'est Sheets("Modèle") alors:

Code: 
With Sheets("Modèle")
.Range("A1:z10000").AdvancedFilter
For Each C In .Range("ab2", .Range("ab65000").End(xlUp))
.Range("ab2") = C
Next C
.Range("A2:z100").ClearContents
End With
Cliquez pour agrandir...

Mes données à récupérer sont dans la feuille "test",
mais j'ai suivi ton conseil et ajouté " On Error Resume Next" ça fonctionne
 
Vote positif 0 Vote négatif
M

miliev83

XLDnaute Occasionnel
Re : Problème "Erreur d'exécution 1004" => comment contourner ?

Actuellement je n'ai pas ce message qui s'affiche, cela écrase directement l'ancien, ce que je souhaite c'est qu'il ne me propose pas de remplacer l'ancien mais qu'il s'enregistre avec "_" et un numéro.

J'ai trouvé cette macro qui pourrait peut être convenir (mais sans l'ajout de la date) mais je n'arrive pas à l'adapter

Code: 
Sub test()
Dim x As String, i As Byte
x = Dir(ThisWorkbook.Path & "\" & Format(Date, "yymmdd") & ".xls")
If x <> "" Then
    Do
        x = Dir(ThisWorkbook.Path & "\" & Format(Date, "yymmdd") & "-" & i + 1 & ".xls")
        i = i + 1
    Loop While x <> ""
    ThisWorkbook.SaveAs Format(Date, "yymmdd") & "-" & i & ".xls"
Else
    ThisWorkbook.SaveAs Format(Date, "yymmdd") & ".xls"
End If
End Sub
 
Vote positif 0 Vote négatif
Lone-wolf

Lone-wolf

XLDnaute Barbatruc
Re : Problème "Erreur d'exécution 1004" => comment contourner ?

Il faut remplacer
ThisWorkbook.SaveAs Format(Date, "yymmdd") & "-" & i & ".xls"
par
ThisWorkbook.SaveAs "_" & ton numero & ".xls"

Mais remplacer ou écraser c'est la même chose. Et si tu regarde bien les lignes SaveAs les deux fichiers n'ont pas le même nom.
 
Dernière édition:
Vote positif 0 Vote négatif
M

miliev83

XLDnaute Occasionnel
Re : Problème "Erreur d'exécution 1004" => comment contourner ?

Oui nous sommes d'accord c'est pour ça que je ne veux pas qu'il remplace ou écrase mais qu'il garde l'ancien et ajoute le nouveau avec un numéro chrono

J'ai essayé de modifier le code ci dessus à mon exemple mais cela ne fonctionne pas, j'ai du mal à comprendre à quoi correspond " x=dir(" par exemple... pourrais-tu m'aider à adapter la macro entièrement ?
 
Dernière édition:
Vote positif 0 Vote négatif
Lone-wolf

Lone-wolf

XLDnaute Barbatruc
Re : Problème "Erreur d'exécution 1004" => comment contourner ?

x=Dir ouvre le classeur A

Si A existe alors classeur A devient classeur A1
Si classeur A1 existe classeur A devient classeur A2 et ainsi de suite, et classeur A reste sous le même nom. Si j'ai bien compris la macro.


NOTE: @ Si...

Si tu passe par là, pardonne moi Si je te nomme à tout bout de champ. gene.gif lone-wf.gif
 

Pièces jointes

  • gene.gif
    gene.gif
    4.5 KB · Affichages: 71
  • lone-wf.gif
    lone-wf.gif
    4.9 KB · Affichages: 67
Dernière édition:
Vote positif 0 Vote négatif
M

miliev83

XLDnaute Occasionnel
Re : Problème "Erreur d'exécution 1004" => comment contourner ?

Ok donc à priori ça correspond à ce que j'attend

J'ai essayé une autre façon mais la maintenant il me dit que la feuille "modèle" est introuvable.... :mad:

Code: 
Sub CreeClasseurs()
Dim Chemin$
Dim x As String, i As Byte
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  [A1:z10000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[ab1], Unique:=True
  For Each C In Range("ab2", Range("ab65000").End(xlUp))
     Range("ab2") = C
     Sheets("Modèle").Select
     [A2:z100].Clear
     Sheets("Test").[A1:z10000].AdvancedFilter Action:=xlFilterCopy, _
         CriteriaRange:=Sheets("Test").[ab1:ab2], CopyToRange:=Sheets("Modèle").[A1:z1], Unique:=False
       ActiveSheet.Copy
       ActiveSheet.Name = C
       Chemin = "C:\Users\Jack\Desktop\test\test2\ABC\"
       If x <> "" Then
    Do
        x = Dir("C:\Users\Jack\Desktop\test\test2\ABC\" & "\" & "-" & i + 1 & ".xls")
        i = i + 1
    Loop While x <> ""
    ThisWorkbook.SaveAs "-" & i & ".xls"
Else
    ThisWorkbook.SaveAs
End If

    Next C
End Sub
 
Vote positif 0 Vote négatif
Lone-wolf

Lone-wolf

XLDnaute Barbatruc
Re : Problème "Erreur d'exécution 1004" => comment contourner ?

Bonjour miliev

Si le fichier est introuvable, c'est que tu as omis d'y inclure le chemin

Code: 
Chemin = "C:\Users\Jack\Desktop\test\test2\ABC\"
If x <> "" Then
Do
 'TU AS DÉJÀ CHEMIN INUTILE DE REPETER  'ET ICI POURQUOI 2 SLASH??
 x = Dir("C:\Users\Jack\Desktop\test\test2\ABC\" & "\" & "-" & i + 1 & ".xls")
 i = i + 1
 Loop While x <> ""
ThisWorkbook.SaveAs   "-" & i & ".xls"
Else
    ThisWorkbook.SaveAs  
End If


Code: 
Chemin = "C:\Users\Jack\Desktop\test\test2\ABC\"
If x <> "" Then
Do
 x = Dir(Chemin & "-" & i + 1 & ".xls")
 i = i + 1
 Loop While x <> ""
'Application.DisplayAlerts = False
ThisWorkbook.SaveAs  FileName:= chemin  &"-" & i & ".xls"
Else
    ThisWorkbook.SaveAs  FileName:= chemin 
End If
 
Dernière édition:
Vote positif 0 Vote négatif
Lone-wolf

Lone-wolf

XLDnaute Barbatruc
Re : Problème "Erreur d'exécution 1004" => comment contourner ?

Re

Voici la macro corrigée et fonctionnelle. Dans ton répertoire, tu dois déjà avoir un classeur nommé "-"

Code: 
Sub Test()
Dim x As String, i As Byte, chemin As String, Obj As Shape

chemin = "C:\Users\Jack\Desktop\test\test2\ABC\"
x = Dir(chemin & "-.xlsm")

If x <> "" Then
    Do
        x = Dir(chemin & "-" & i + 1 & ".xls")
        i = i + 1
    Loop While x <> ""
    ThisWorkbook.SaveAs Filename:=chemin & "-" & i & ".xls"
        Application.ScreenUpdating = False
    With ActiveWorkbook
    For Each Obj In .ActiveSheet.Shapes
        If Obj.Type = 8 Then Obj.Delete
    Next Obj
    Application.DisplayAlerts = False
    .Save
    End With
Else
    ThisWorkbook.SaveAs Filename:=chemin & "-" & ".xls"
End If
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Lone-wolf

Lone-wolf

XLDnaute Barbatruc
Re : Problème "Erreur d'exécution 1004" => comment contourner ?

Bonsoir à moi tout seul

@ miliev: Si tu passe par là (pas toi Si..., ça suffit maintenant!! furieux-2.gif), prends celui-ci comme code.


Code: 
Sub Test()
Dim rep, chemin, nom As String, i As Byte, Obj As Shape

chemin = "C:\Users\Jack\Desktop\test\test2\ABC\"
nom = "-" & ".xlsm"
rep = Dir(chemin & nom)

If rep <> "" Then
    Do
        rep = Dir(chemin & "-" & i + 1 & ".xlsm")
        i = i + 1
    Loop While rep <> ""
    ThisWorkbook.SaveAs Filename:=chemin & "-" & i & ".xlsm"
        Application.ScreenUpdating = False
    On Error Resume Next
    With ActiveWorkbook
    For Each Obj In .ActiveSheet.Shapes
        If Obj.Type = 8 Then Obj.Delete
    Next Obj
    Workbooks.Open chemin & nom
    Application.DisplayAlerts = False
    .Close True
    End With
Else
    ThisWorkbook.SaveAs Filename:=chemin & nom
End If
End Sub
 

Pièces jointes

  • furieux-2.gif
    furieux-2.gif
    5.1 KB · Affichages: 56
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

V
  • Résolu(e)
XL 2016 Exportation au format PDF à l'aide d'une macro : erreur 1004 'Document non enregistré'
Réponses
14
Affichages
514
Phil69970
Phil69970
luke3300
  • Question
Microsoft 365 Erreur de macro
Réponses
4
Affichages
528
luke3300
luke3300
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
1 K
AtTheOne
AtTheOne
D
  • Question
XL 2019 Comment réappliquer automatiquement le filtre automatique lorsque les données changent dans Excel?
Réponses
8
Affichages
880
DomL
D
Deadpool_CC
  • Résolu(e)
XL 2016 Selection.AdvancedFilter Action:=xlFilterCopy
Réponses
6
Affichages
576
Deadpool_CC
Deadpool_CC
O
  • Résolu(e)
XL 2016 Faire apparaitre un tableau en fonction d'un choix déroulant
Réponses
2
Affichages
387
onicow
O
K
  • Résolu(e)
XL 2019 ListObjects -- Erreur 1004
Réponses
3
Affichages
562
patricktoulon
patricktoulon
BalighTomy
  • Résolu(e)
Autres Recherche Vba
Réponses
1
Affichages
706
sylvanu
sylvanu
B
  • Question
XL 2019 Filtre élaboré sur des données alphanumériques
Réponses
1
Affichages
670
Staple1600
Staple1600
I
  • Question
XL 2019 Filtre Avancé avec un tableau comme cristaire vba
Réponses
0
Affichages
832
iliess
I

Membres actuellement en ligne

19 membres et 380 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 185
Messages
2 086 018
Membres
103 094
dernier inscrit
Molinari