macro qui tourne à l'infini sans pour autant bogger

Le
François
Bonjour à tous,

J'ai un fichier (calendrier) qui contient une macro "d'archivage" qui
sélectionne la feuille active (le mois d'octobre par exemple) ainsi que la
feuille de décompte associée (octobre.list) reprenant le même nom de feuille
en y ajoutant ".list", et les transfert dans un fichier portant le même nom
de fichier mais précédé de "Old " (dans le même dossier).
Si ce dossier (Old ) n'existe pas, il est alors créé.

Problème : cette macro tourne à l'infini sans pour autant bloquer !

Je ne comprends pas où est mon erreur !

Si l'un d'entre-vous a une piste ?
(je peux mettre le fichier en Cjoint si nécessaire)

Merci à tous

François

Sub archiver()

Dim base As String, chemin As String, feuille As String, fichier As
String
Dim repere As Byte
chemin = ActiveWorkbook.Path & ""
base = ActiveWorkbook.Name
fichier = Dir$(chemin & "*.xls")
feuille = ActiveSheet.Name
repere = 0
Do Until fichier = ""
If fichier = "Old " & base Then
repere = 1
Workbooks.Open (chemin & "Old " & base)
Workbooks(base).Sheets(feuille & ".list").Select
Sheets(feuille & ".list").Move After:=Workbooks("Old " &
base).Sheets(Sheets.Count)
Workbooks(base).Sheets(feuille).Select
Sheets(feuille).Move After:=Workbooks("Old " &
base).Sheets(Sheets.Count)
End If
Loop
If repere = 0 Then
Dim wsh As Worksheet
Application.DisplayAlerts = False
For Each wsh In ActiveWorkbook.Sheets
If wsh.Name <> feuille And wsh.Name <> feuille & ".list" Then
Sheets(wsh.Name).Delete
End If
Application.DisplayAlerts = True
Next
ActiveWorkbook.SaveAs Filename:=chemin & "Old " & base
Workbooks.Open (chemin & base)
Workbooks(chemin & "Old " & base).Close SaveChanges:úlse
End If
End Sub
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
LSteph
Le #4864591
Bonjour,

C'est sans doute parceque tu as mis

fichier= Dir$(chemin & "*.xls")
et
Do Until fichier = ""
qui ne sera jamais ="" puisqu'au moins = à chemin

Essaie plutôt quelque chose ainsi,
fichier= dir("*.xls")
mais en ajoutant
Chdir chemin

attention j'ai repris mais pas testé:

''''''''''''''''''
Sub archiver()

Dim base As String, chemin As String, feuille As String, _
fichier As String

Dim repere As Byte
chemin = ActiveWorkbook.Path & ""
base = ActiveWorkbook.Name
fichier= dir("*.xls")
feuille = ActiveSheet.Name
repere = 0
Chdir chemin
Do While len(fichier)>0
If fichier = "Old " & base Then
repere = 1
Workbooks.Open ("Old " & base)
Workbooks(base).Sheets(feuille & ".list").Move _
After:=Workbooks("Old " & base).Sheets(Sheets.Count)
Workbooks(base).Sheets(feuille).Move _
After:=Workbooks("Old " & base).Sheets(Sheets.Count)
End If
Loop
If repere = 0 Then
Dim wsh As Worksheet
Application.DisplayAlerts = False
For Each wsh In ActiveWorkbook.Sheets
If wsh.Name Sheets(wsh.Name).Delete
End If
Application.DisplayAlerts = True
Next
ActiveWorkbook.SaveAs Filename:="Old " & base
Workbooks.Open (base)
Workbooks("Old " & base).Close False
End If
End Sub


'lSteph

Bonjour à tous,

J'ai un fichier (calendrier) qui contient une macro "d'archivage" qui
sélectionne la feuille active (le mois d'octobre par exemple) ainsi que la
feuille de décompte associée (octobre.list) reprenant le même nom de feuille
en y ajoutant ".list", et les transfert dans un fichier portant le même nom
de fichier mais précédé de "Old " (dans le même dossier).
Si ce dossier (Old ...) n'existe pas, il est alors créé.

Problème : cette macro tourne à l'infini sans pour autant bloquer !

Je ne comprends pas où est mon erreur !

Si l'un d'entre-vous a une piste ?...
(je peux mettre le fichier en Cjoint si nécessaire)

Merci à tous

François

Sub archiver()

Dim base As String, chemin As String, feuille As String, fichier As
String
Dim repere As Byte
chemin = ActiveWorkbook.Path & ""
base = ActiveWorkbook.Name
fichier = Dir$(chemin & "*.xls")
feuille = ActiveSheet.Name
repere = 0
Do Until fichier = ""
If fichier = "Old " & base Then
repere = 1
Workbooks.Open (chemin & "Old " & base)
Workbooks(base).Sheets(feuille & ".list").Select
Sheets(feuille & ".list").Move After:=Workbooks("Old " &
base).Sheets(Sheets.Count)
Workbooks(base).Sheets(feuille).Select
Sheets(feuille).Move After:=Workbooks("Old " &
base).Sheets(Sheets.Count)
End If
Loop
If repere = 0 Then
Dim wsh As Worksheet
Application.DisplayAlerts = False
For Each wsh In ActiveWorkbook.Sheets
If wsh.Name Sheets(wsh.Name).Delete
End If
Application.DisplayAlerts = True
Next
ActiveWorkbook.SaveAs Filename:=chemin & "Old " & base
Workbooks.Open (chemin & base)
Workbooks(chemin & "Old " & base).Close SaveChanges:úlse
End If
End Sub





LSteph
Le #4864581
...heu, pardon,le fichier =dir("*.xls")
;o) à mettre juste après le Chdir sinon cela ne sert à rien...!

'...
Chdir chemin
fichier= dir("*.xls")
Do While len(fichier)>0
'....

et puis le rappeler dans le do while ... avant le loop sinon on boucle
toujours le même

'...
fichier=dir
Loop
'...

Bonjour,

C'est sans doute parceque tu as mis

fichier= Dir$(chemin & "*.xls")
et
Do Until fichier = ""
qui ne sera jamais ="" puisqu'au moins = à chemin

Essaie plutôt quelque chose ainsi,
fichier= dir("*.xls")
mais en ajoutant
Chdir chemin

attention j'ai repris mais pas testé:

''''''''''''''''''
Sub archiver()

Dim base As String, chemin As String, feuille As String, _
fichier As String

Dim repere As Byte
chemin = ActiveWorkbook.Path & ""
base = ActiveWorkbook.Name
fichier= dir("*.xls")
feuille = ActiveSheet.Name
repere = 0
Chdir chemin
Do While len(fichier)>0
If fichier = "Old " & base Then
repere = 1
Workbooks.Open ("Old " & base)
Workbooks(base).Sheets(feuille & ".list").Move _
After:=Workbooks("Old " & base).Sheets(Sheets.Count)
Workbooks(base).Sheets(feuille).Move _
After:=Workbooks("Old " & base).Sheets(Sheets.Count)
End If
Loop
If repere = 0 Then
Dim wsh As Worksheet
Application.DisplayAlerts = False
For Each wsh In ActiveWorkbook.Sheets
If wsh.Name Sheets(wsh.Name).Delete
End If
Application.DisplayAlerts = True
Next
ActiveWorkbook.SaveAs Filename:="Old " & base
Workbooks.Open (base)
Workbooks("Old " & base).Close False
End If
End Sub


'lSteph

Bonjour à tous,

J'ai un fichier (calendrier) qui contient une macro "d'archivage" qui
sélectionne la feuille active (le mois d'octobre par exemple) ainsi
que la feuille de décompte associée (octobre.list) reprenant le même
nom de feuille en y ajoutant ".list", et les transfert dans un fichier
portant le même nom de fichier mais précédé de "Old " (dans le même
dossier).
Si ce dossier (Old ...) n'existe pas, il est alors créé.

Problème : cette macro tourne à l'infini sans pour autant bloquer !

Je ne comprends pas où est mon erreur !

Si l'un d'entre-vous a une piste ?...
(je peux mettre le fichier en Cjoint si nécessaire)

Merci à tous

François

Sub archiver()

Dim base As String, chemin As String, feuille As String, fichier
As String
Dim repere As Byte
chemin = ActiveWorkbook.Path & ""
base = ActiveWorkbook.Name
fichier = Dir$(chemin & "*.xls")
feuille = ActiveSheet.Name
repere = 0
Do Until fichier = ""
If fichier = "Old " & base Then
repere = 1
Workbooks.Open (chemin & "Old " & base)
Workbooks(base).Sheets(feuille & ".list").Select
Sheets(feuille & ".list").Move After:=Workbooks("Old " &
base).Sheets(Sheets.Count)
Workbooks(base).Sheets(feuille).Select
Sheets(feuille).Move After:=Workbooks("Old " &
base).Sheets(Sheets.Count)
End If
Loop
If repere = 0 Then
Dim wsh As Worksheet
Application.DisplayAlerts = False
For Each wsh In ActiveWorkbook.Sheets
If wsh.Name Sheets(wsh.Name).Delete
End If
Application.DisplayAlerts = True
Next
ActiveWorkbook.SaveAs Filename:=chemin & "Old " & base
Workbooks.Open (chemin & base)
Workbooks(chemin & "Old " & base).Close SaveChanges:úlse
End If
End Sub







François
Le #4864421
Bonjour,

Il y a un problème dans ta boucle Do Until fichier = "" ... Loop.
En effet, si tu entres dans la boucle (variable fichier <> ""), tu ne
pourras plus en sortir, vu que tu ne modifies pas cette variable à
l'intérieur de la boucle.

Je pense que tu as oublié

fichier=Dir

juste avant le Loop.

A+

François


"François" %
Bonjour à tous,

J'ai un fichier (calendrier) qui contient une macro "d'archivage" qui
sélectionne la feuille active (le mois d'octobre par exemple) ainsi que la
feuille de décompte associée (octobre.list) reprenant le même nom de
feuille en y ajoutant ".list", et les transfert dans un fichier portant le
même nom de fichier mais précédé de "Old " (dans le même dossier).
Si ce dossier (Old ...) n'existe pas, il est alors créé.

Problème : cette macro tourne à l'infini sans pour autant bloquer !

Je ne comprends pas où est mon erreur !

Si l'un d'entre-vous a une piste ?...
(je peux mettre le fichier en Cjoint si nécessaire)

Merci à tous

François

Sub archiver()

Dim base As String, chemin As String, feuille As String, fichier As
String
Dim repere As Byte
chemin = ActiveWorkbook.Path & ""
base = ActiveWorkbook.Name
fichier = Dir$(chemin & "*.xls")
feuille = ActiveSheet.Name
repere = 0
Do Until fichier = ""
If fichier = "Old " & base Then
repere = 1
Workbooks.Open (chemin & "Old " & base)
Workbooks(base).Sheets(feuille & ".list").Select
Sheets(feuille & ".list").Move After:=Workbooks("Old " &
base).Sheets(Sheets.Count)
Workbooks(base).Sheets(feuille).Select
Sheets(feuille).Move After:=Workbooks("Old " &
base).Sheets(Sheets.Count)
End If
Loop
If repere = 0 Then
Dim wsh As Worksheet
Application.DisplayAlerts = False
For Each wsh In ActiveWorkbook.Sheets
If wsh.Name Sheets(wsh.Name).Delete
End If
Application.DisplayAlerts = True
Next
ActiveWorkbook.SaveAs Filename:=chemin & "Old " & base
Workbooks.Open (chemin & base)
Workbooks(chemin & "Old " & base).Close SaveChanges:úlse
End If
End Sub






François
Le #4864271
Merci beaucoup,

Vous avez résolu un problème que ma connaissance (très partielle) du vab de
Excel n'effleurait même pas.

Tout fonctionne bien maintenant.

Merci à Lsteph et François.

François

"François" %
Bonjour à tous,

J'ai un fichier (calendrier) qui contient une macro "d'archivage" qui
sélectionne la feuille active (le mois d'octobre par exemple) ainsi que la
feuille de décompte associée (octobre.list) reprenant le même nom de
feuille en y ajoutant ".list", et les transfert dans un fichier portant le
même nom de fichier mais précédé de "Old " (dans le même dossier).
Si ce dossier (Old ...) n'existe pas, il est alors créé.

Problème : cette macro tourne à l'infini sans pour autant bloquer !

Je ne comprends pas où est mon erreur !

Si l'un d'entre-vous a une piste ?...
(je peux mettre le fichier en Cjoint si nécessaire)

Merci à tous

François

Sub archiver()

Dim base As String, chemin As String, feuille As String, fichier As
String
Dim repere As Byte
chemin = ActiveWorkbook.Path & ""
base = ActiveWorkbook.Name
fichier = Dir$(chemin & "*.xls")
feuille = ActiveSheet.Name
repere = 0
Do Until fichier = ""
If fichier = "Old " & base Then
repere = 1
Workbooks.Open (chemin & "Old " & base)
Workbooks(base).Sheets(feuille & ".list").Select
Sheets(feuille & ".list").Move After:=Workbooks("Old " &
base).Sheets(Sheets.Count)
Workbooks(base).Sheets(feuille).Select
Sheets(feuille).Move After:=Workbooks("Old " &
base).Sheets(Sheets.Count)
End If
Loop
If repere = 0 Then
Dim wsh As Worksheet
Application.DisplayAlerts = False
For Each wsh In ActiveWorkbook.Sheets
If wsh.Name Sheets(wsh.Name).Delete
End If
Application.DisplayAlerts = True
Next
ActiveWorkbook.SaveAs Filename:=chemin & "Old " & base
Workbooks.Open (chemin & base)
Workbooks(chemin & "Old " & base).Close SaveChanges:úlse
End If
End Sub





jps
Le #4864211
un vab?
on avait déjà les scuds....ça devient la guerre ici
jps

"François"
Merci beaucoup,

Vous avez résolu un problème que ma connaissance (très partielle) du vab
de Excel n'effleurait même pas.

Tout fonctionne bien maintenant.

Merci à Lsteph et François.

François

"François" %
Bonjour à tous,

J'ai un fichier (calendrier) qui contient une macro "d'archivage" qui
sélectionne la feuille active (le mois d'octobre par exemple) ainsi que
la feuille de décompte associée (octobre.list) reprenant le même nom de
feuille en y ajoutant ".list", et les transfert dans un fichier portant
le même nom de fichier mais précédé de "Old " (dans le même dossier).
Si ce dossier (Old ...) n'existe pas, il est alors créé.

Problème : cette macro tourne à l'infini sans pour autant bloquer !

Je ne comprends pas où est mon erreur !

Si l'un d'entre-vous a une piste ?...
(je peux mettre le fichier en Cjoint si nécessaire)

Merci à tous

François

Sub archiver()

Dim base As String, chemin As String, feuille As String, fichier As
String
Dim repere As Byte
chemin = ActiveWorkbook.Path & ""
base = ActiveWorkbook.Name
fichier = Dir$(chemin & "*.xls")
feuille = ActiveSheet.Name
repere = 0
Do Until fichier = ""
If fichier = "Old " & base Then
repere = 1
Workbooks.Open (chemin & "Old " & base)
Workbooks(base).Sheets(feuille & ".list").Select
Sheets(feuille & ".list").Move After:=Workbooks("Old " &
base).Sheets(Sheets.Count)
Workbooks(base).Sheets(feuille).Select
Sheets(feuille).Move After:=Workbooks("Old " &
base).Sheets(Sheets.Count)
End If
Loop
If repere = 0 Then
Dim wsh As Worksheet
Application.DisplayAlerts = False
For Each wsh In ActiveWorkbook.Sheets
If wsh.Name Sheets(wsh.Name).Delete
End If
Application.DisplayAlerts = True
Next
ActiveWorkbook.SaveAs Filename:=chemin & "Old " & base
Workbooks.Open (chemin & base)
Workbooks(chemin & "Old " & base).Close SaveChanges:úlse
End If
End Sub









LSteph
Le #4864131
;o)

un vab?
on avait déjà les scuds....ça devient la guerre ici
jps

"François"
Merci beaucoup,

Vous avez résolu un problème que ma connaissance (très partielle) du vab
de Excel n'effleurait même pas.

Tout fonctionne bien maintenant.

Merci à Lsteph et François.

François

"François" %
Bonjour à tous,

J'ai un fichier (calendrier) qui contient une macro "d'archivage" qui
sélectionne la feuille active (le mois d'octobre par exemple) ainsi que
la feuille de décompte associée (octobre.list) reprenant le même nom de
feuille en y ajoutant ".list", et les transfert dans un fichier portant
le même nom de fichier mais précédé de "Old " (dans le même dossier).
Si ce dossier (Old ...) n'existe pas, il est alors créé.

Problème : cette macro tourne à l'infini sans pour autant bloquer !

Je ne comprends pas où est mon erreur !

Si l'un d'entre-vous a une piste ?...
(je peux mettre le fichier en Cjoint si nécessaire)

Merci à tous

François

Sub archiver()

Dim base As String, chemin As String, feuille As String, fichier As
String
Dim repere As Byte
chemin = ActiveWorkbook.Path & ""
base = ActiveWorkbook.Name
fichier = Dir$(chemin & "*.xls")
feuille = ActiveSheet.Name
repere = 0
Do Until fichier = ""
If fichier = "Old " & base Then
repere = 1
Workbooks.Open (chemin & "Old " & base)
Workbooks(base).Sheets(feuille & ".list").Select
Sheets(feuille & ".list").Move After:=Workbooks("Old " &
base).Sheets(Sheets.Count)
Workbooks(base).Sheets(feuille).Select
Sheets(feuille).Move After:=Workbooks("Old " &
base).Sheets(Sheets.Count)
End If
Loop
If repere = 0 Then
Dim wsh As Worksheet
Application.DisplayAlerts = False
For Each wsh In ActiveWorkbook.Sheets
If wsh.Name Sheets(wsh.Name).Delete
End If
Application.DisplayAlerts = True
Next
ActiveWorkbook.SaveAs Filename:=chemin & "Old " & base
Workbooks.Open (chemin & base)
Workbooks(chemin & "Old " & base).Close SaveChanges:úlse
End If
End Sub












François
Le #4812311
Merci à tous,

(et pardon pour le retard ...)

Cela fonctionne désormais parfaitement.

François

"LSteph"
...heu, pardon,le fichier =dir("*.xls")
;o) à mettre juste après le Chdir sinon cela ne sert à rien...!

'...
Chdir chemin
fichier= dir("*.xls")
Do While len(fichier)>0
'....

et puis le rappeler dans le do while ... avant le loop sinon on boucle
toujours le même

'...
fichier=dir
Loop
'...

Bonjour,

C'est sans doute parceque tu as mis

fichier= Dir$(chemin & "*.xls")
et
Do Until fichier = ""
qui ne sera jamais ="" puisqu'au moins = à chemin

Essaie plutôt quelque chose ainsi,
fichier= dir("*.xls")
mais en ajoutant
Chdir chemin

attention j'ai repris mais pas testé:

''''''''''''''''''
Sub archiver()

Dim base As String, chemin As String, feuille As String, _
fichier As String

Dim repere As Byte
chemin = ActiveWorkbook.Path & ""
base = ActiveWorkbook.Name
fichier= dir("*.xls")
feuille = ActiveSheet.Name
repere = 0
Chdir chemin
Do While len(fichier)>0
If fichier = "Old " & base Then
repere = 1
Workbooks.Open ("Old " & base)
Workbooks(base).Sheets(feuille & ".list").Move _
After:=Workbooks("Old " & base).Sheets(Sheets.Count)
Workbooks(base).Sheets(feuille).Move _
After:=Workbooks("Old " & base).Sheets(Sheets.Count)
End If
Loop
If repere = 0 Then
Dim wsh As Worksheet
Application.DisplayAlerts = False
For Each wsh In ActiveWorkbook.Sheets
If wsh.Name Sheets(wsh.Name).Delete
End If
Application.DisplayAlerts = True
Next
ActiveWorkbook.SaveAs Filename:="Old " & base
Workbooks.Open (base)
Workbooks("Old " & base).Close False
End If
End Sub


'lSteph

Bonjour à tous,

J'ai un fichier (calendrier) qui contient une macro "d'archivage" qui
sélectionne la feuille active (le mois d'octobre par exemple) ainsi que
la feuille de décompte associée (octobre.list) reprenant le même nom de
feuille en y ajoutant ".list", et les transfert dans un fichier portant
le même nom de fichier mais précédé de "Old " (dans le même dossier).
Si ce dossier (Old ...) n'existe pas, il est alors créé.

Problème : cette macro tourne à l'infini sans pour autant bloquer !

Je ne comprends pas où est mon erreur !

Si l'un d'entre-vous a une piste ?...
(je peux mettre le fichier en Cjoint si nécessaire)

Merci à tous

François

Sub archiver()

Dim base As String, chemin As String, feuille As String, fichier As
String
Dim repere As Byte
chemin = ActiveWorkbook.Path & ""
base = ActiveWorkbook.Name
fichier = Dir$(chemin & "*.xls")
feuille = ActiveSheet.Name
repere = 0
Do Until fichier = ""
If fichier = "Old " & base Then
repere = 1
Workbooks.Open (chemin & "Old " & base)
Workbooks(base).Sheets(feuille & ".list").Select
Sheets(feuille & ".list").Move After:=Workbooks("Old " &
base).Sheets(Sheets.Count)
Workbooks(base).Sheets(feuille).Select
Sheets(feuille).Move After:=Workbooks("Old " &
base).Sheets(Sheets.Count)
End If
Loop
If repere = 0 Then
Dim wsh As Worksheet
Application.DisplayAlerts = False
For Each wsh In ActiveWorkbook.Sheets
If wsh.Name Then
Sheets(wsh.Name).Delete
End If
Application.DisplayAlerts = True
Next
ActiveWorkbook.SaveAs Filename:=chemin & "Old " & base
Workbooks.Open (chemin & base)
Workbooks(chemin & "Old " & base).Close SaveChanges:úlse
End If
End Sub









Publicité
Poster une réponse
Anonyme