macro pour tranférer des feuilles qui bug sans que je sache pourquoi ...

Bonjour à tous,

J'ai une macro (bouton "transfert to old file") qui transfert les 2
feuilles d'un mois écoulé dans un fichier d'archivage (du même nom mais
précédé de "Old")
Si ce fichier n'existe pas pour l'année en cours, il est créé, sinon il
est ouvert afin d'y transférer ces 2 feuilles.
Le fichier est protégé à l'ouverture par un MdP (rouen), et les macros par
un autre MdP (bosquet).

Le problème que j'ai, c'est que lors du transfert de feuille dans le
fichier déjà créé, la macro bug sans que j'y vois de raison sur la ligne :
Workbooks("Old " & annee & " " & base).Open , Password:="rouen"

l'aide en ligne d'excel m'indique "indice en dehors de la plage - erreur
9"
Voici l'ensemble du programme en cause,
ou sinon le fichier en Cjoint : http://cjoint.com/?kBtahDM2w5

auriez-vous une idée de ce qui cause le problème ?

Merci à tous

François

Sub archiver()

Dim base As String, chemin As String, feuille As String, fichier As
String, annee As String, n As Byte
Dim repere As Byte, wsh As Worksheet, Wk As Workbook, vbProj As Object


Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
feuille = InputBox("Enter the password ...", "Password to transfer to
the old file")
If feuille <> "rouen" Then Exit Sub
feuille = ActiveSheet.Name
feuille = InputBox("Enter the name of the calendar sheet to delete
...", "Sheet to transfer to the old file", feuille)
chemin = ActiveWorkbook.Path & ""
base = ActiveWorkbook.Name
annee = Year([A2])
ChDir chemin
fichier = Dir("*.xls")
repere = 0
For n = 1 To 9
ActiveSheet.Cells(n, 28).Name.Delete
Next n
ChDir chemin
Do While Len(fichier) > 0
If fichier = "Old " & annee & " " & base Then
repere = 1
Workbooks("Old " & annee & " " & base).Open , Password:="rouen"
Workbooks(base).Sheets(feuille & ".list").Move _
After:=Workbooks("Old " & annee & " " &
base).Sheets(Sheets.Count)
Workbooks(base).Sheets(feuille).Move _
After:=Workbooks("Old " & annee & " " &
base).Sheets(Sheets.Count)
Workbooks("Old " & annee & " " & base).Sheets(feuille).Activate
Set vbProj = ActiveWorkbook.VBProject
If vbProj.Protection <> 1 Then Exit Sub 'Teste si le classeur
est déjà déprotégé
Set Application.VBE.ActiveVBProject = vbProj
SendKeys "+{TAB}{RIGHT}%V{+}{TAB}" & "bosquet" & "{TAB}" &
"bosquet" & "~" 'uilise les sendkeys pourmasquer le mot de passe du projet
Application.VBE.CommandBars(1).FindControl(ID:%78,
recursive:=True).Execute
Application.ScreenUpdating = True
Set VBComps = ActiveWorkbook.VBProject.VBComponents
For Each VBComp In VBComps
Select Case VBComp.Type
Case 100
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Case Else
VBComps.Remove VBComp
End Select
Next
Workbooks("Old " & annee & " " & base).Close SaveChanges:=True
End If
fichier = Dir
Loop
If repere = 0 Then
Sheets("Memoire").Visible = True
For Each wsh In ActiveWorkbook.Sheets
If wsh.Name <> feuille And wsh.Name <> feuille & ".list" And
wsh.Name <> "Memoire" Then
Sheets(wsh.Name).Delete
End If
Next
Sheets("Memoire").Visible = xlVeryHidden ' we hide secret sheets,
if no longer Very hidden
ActiveWorkbook.SaveAs Filename:="Old " & annee & " " & base
Workbooks.Open Filename:ºse, Password:="rouen"
Workbooks(base).Sheets(feuille & ".list").Activate
Workbooks(base).Sheets(feuille & ".list").Delete
Workbooks(base).Sheets(feuille).Delete
Workbooks(base).Save
Workbooks("Old " & annee & " " & base).Sheets(feuille).Activate
MsgBox ("Don't forget to save the new created ""old"" file !")
Set vbProj = ActiveWorkbook.VBProject
If vbProj.Protection <> 1 Then GoTo marque 'Teste si le
classeur est déjà déprotégé
Set Application.VBE.ActiveVBProject = vbProj
SendKeys "+{TAB}{RIGHT}%V{+}{TAB}" & "bosquet" & "{TAB}" &
"bosquet" & "~" 'uilise les sendkeys pourmasquer le mot de passe du projet
Application.VBE.CommandBars(1).FindControl(ID:%78,
recursive:=True).Execute
marque:
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
Set VBComps = ActiveWorkbook.VBProject.VBComponents
For Each VBComp In VBComps
Select Case VBComp.Type
Case 100
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Case Else
VBComps.Remove VBComp
End Select
Next
End If
End Sub

Salut françois,
Sans conviction, je pense qu'il manque un "Exit Do" avant le End If dans
la boucle du Do---Loop
Je n'ai rien vu pour le faire quitter le Do Loop.

Exit Do ' < < < ici
End If
fichier = Dir
Loop

Youky


"François" <nospam@nospam.fr> a écrit dans le message de news:
uyS1OvLGIHA.748@TK2MSFTNGP04.phx.gbl...

Bonjour à tous,

J'ai une macro (bouton "transfert to old file") qui transfert les 2
feuilles d'un mois écoulé dans un fichier d'archivage (du même nom mais
précédé de "Old")
Si ce fichier n'existe pas pour l'année en cours, il est créé, sinon il
est ouvert afin d'y transférer ces 2 feuilles.
Le fichier est protégé à l'ouverture par un MdP (rouen), et les macros
par un autre MdP (bosquet).

Le problème que j'ai, c'est que lors du transfert de feuille dans le
fichier déjà créé, la macro bug sans que j'y vois de raison sur la ligne
:
Workbooks("Old " & annee & " " & base).Open , Password:="rouen"

l'aide en ligne d'excel m'indique "indice en dehors de la plage - erreur
9"
Voici l'ensemble du programme en cause,
ou sinon le fichier en Cjoint : http://cjoint.com/?kBtahDM2w5

auriez-vous une idée de ce qui cause le problème ?

Merci à tous

François

Sub archiver()

Dim base As String, chemin As String, feuille As String, fichier As
String, annee As String, n As Byte
Dim repere As Byte, wsh As Worksheet, Wk As Workbook, vbProj As Object


Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
feuille = InputBox("Enter the password ...", "Password to transfer to
the old file")
If feuille <> "rouen" Then Exit Sub
feuille = ActiveSheet.Name
feuille = InputBox("Enter the name of the calendar sheet to delete
...", "Sheet to transfer to the old file", feuille)
chemin = ActiveWorkbook.Path & ""
base = ActiveWorkbook.Name
annee = Year([A2])
ChDir chemin
fichier = Dir("*.xls")
repere = 0
For n = 1 To 9
ActiveSheet.Cells(n, 28).Name.Delete
Next n
ChDir chemin
Do While Len(fichier) > 0
If fichier = "Old " & annee & " " & base Then
repere = 1
Workbooks("Old " & annee & " " & base).Open ,
Password:="rouen"
Workbooks(base).Sheets(feuille & ".list").Move _
After:=Workbooks("Old " & annee & " " &
base).Sheets(Sheets.Count)
Workbooks(base).Sheets(feuille).Move _
After:=Workbooks("Old " & annee & " " &
base).Sheets(Sheets.Count)
Workbooks("Old " & annee & " " &
base).Sheets(feuille).Activate
Set vbProj = ActiveWorkbook.VBProject
If vbProj.Protection <> 1 Then Exit Sub 'Teste si le classeur
est déjà déprotégé
Set Application.VBE.ActiveVBProject = vbProj
SendKeys "+{TAB}{RIGHT}%V{+}{TAB}" & "bosquet" & "{TAB}" &
"bosquet" & "~" 'uilise les sendkeys pourmasquer le mot de passe du
projet
Application.VBE.CommandBars(1).FindControl(ID:%78,
recursive:=True).Execute
Application.ScreenUpdating = True
Set VBComps = ActiveWorkbook.VBProject.VBComponents
For Each VBComp In VBComps
Select Case VBComp.Type
Case 100
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Case Else
VBComps.Remove VBComp
End Select
Next
Workbooks("Old " & annee & " " & base).Close SaveChanges:=True
End If
fichier = Dir
Loop
If repere = 0 Then
Sheets("Memoire").Visible = True
For Each wsh In ActiveWorkbook.Sheets
If wsh.Name <> feuille And wsh.Name <> feuille & ".list" And
wsh.Name <> "Memoire" Then
Sheets(wsh.Name).Delete
End If
Next
Sheets("Memoire").Visible = xlVeryHidden ' we hide secret sheets,
if no longer Very hidden
ActiveWorkbook.SaveAs Filename:="Old " & annee & " " & base
Workbooks.Open Filename:ºse, Password:="rouen"
Workbooks(base).Sheets(feuille & ".list").Activate
Workbooks(base).Sheets(feuille & ".list").Delete
Workbooks(base).Sheets(feuille).Delete
Workbooks(base).Save
Workbooks("Old " & annee & " " & base).Sheets(feuille).Activate
MsgBox ("Don't forget to save the new created ""old"" file !")
Set vbProj = ActiveWorkbook.VBProject
If vbProj.Protection <> 1 Then GoTo marque 'Teste si le
classeur est déjà déprotégé
Set Application.VBE.ActiveVBProject = vbProj
SendKeys "+{TAB}{RIGHT}%V{+}{TAB}" & "bosquet" & "{TAB}" &
"bosquet" & "~" 'uilise les sendkeys pourmasquer le mot de passe du
projet
Application.VBE.CommandBars(1).FindControl(ID:%78,
recursive:=True).Execute
marque:
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
Set VBComps = ActiveWorkbook.VBProject.VBComponents
For Each VBComp In VBComps
Select Case VBComp.Type
Case 100
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Case Else
VBComps.Remove VBComp
End Select
Next
End If
End Sub