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
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
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
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 <> feuille And wsh.Name <> feuille & ".list" Then
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
'lStephBonjour à 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
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 <> feuille And wsh.Name <> feuille & ".list" Then
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 <> 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
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 <> feuille And wsh.Name <> feuille & ".list" Then
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
'lStephBonjour à 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
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
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
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
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
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
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
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" a écrit dans le message de news:
%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
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" <nospam@nospam.fr> a écrit dans le message de news:
%23ArxRVDzHHA.1212@TK2MSFTNGP05.phx.gbl...
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
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" a écrit dans le message de news:
%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
un vab?
on avait déjà les scuds....ça devient la guerre ici
jps
"François" a écrit dans le message de news: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" a écrit dans le message de news:
%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
un vab?
on avait déjà les scuds....ça devient la guerre ici
jps
"François" <nospam@nospam.fr> a écrit dans le message de news:
uDrkWHKzHHA.5380@TK2MSFTNGP04.phx.gbl...
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" <nospam@nospam.fr> a écrit dans le message de news:
%23ArxRVDzHHA.1212@TK2MSFTNGP05.phx.gbl...
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
un vab?
on avait déjà les scuds....ça devient la guerre ici
jps
"François" a écrit dans le message de news: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" a écrit dans le message de news:
%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
...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 <> feuille And wsh.Name <> feuille & ".list" Then
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
'lStephBonjour à 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
...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 <> feuille And wsh.Name <> feuille & ".list" Then
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 <> 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
...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 <> feuille And wsh.Name <> feuille & ".list" Then
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
'lStephBonjour à 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