Archivage qui fonctionne mal

Bricoltou · 17 Décembre 2009

Bondoir le Fil

J'ai écrit ce code afin d'archiver un fichier A, puis copie d'un autre fichier B que je copie sur le A .
La macro fonctione mal car je n'arrive pas a vider les cellules dans les onglets de la semaine (Ligne bleu du code )

Pouvez vous m'aider ?
Merci d'avance

Bricoltou

Code:

Private Sub ListBoxarchive_Change()
Select Case ListBoxarchive.Value
Case "Matrice_Chauffeur"
        Workbooks.Open Filename:= _
      "C:\Documents and Settings\Desktop\Camionnage\Matrice_Chauffeur.xls"
      Application.DisplayAlerts = True
      Dim no_sem As String
      ActiveSheet.Unprotect Password:="Terminal"
      no_sem = InputBox("Saisissez le numéro de la semaine ", "No de semaine")
     ChDir "C:\Documents and Settings\Desktop\Camionnage\Archives\Planning"
       ActiveWorkbook.SaveAs Filename:="C:\Documents and Settings\Desktop\Camionnage\Archives\Planning\" & "Planning" & no_sem & ".xls"
      Application.DisplayAlerts = False
      ActiveWorkbook.Close
         Workbooks.Open Filename:= _
           "C:\Documents and Settings\Desktop\Camionnage\Matrice_Chauffeur.xls"
            ActiveSheet.Unprotect Password:="Terminal"
            Range("B3").Select
            Selection.ClearContents
            Range("A" & 6 + decalage_cellule_vers_le_bas & ":H" & 23 + decalage_cellule_vers_le_bas).Select
            Selection.ClearContents
            Range("A" & 24 + decalage_cellule_vers_le_bas & ":H" & 42 + decalage_cellule_vers_le_bas).Select
            Selection.ClearContents
            Range("A" & 43 + decalage_cellule_vers_le_bas & ":H" & 58 + decalage_cellule_vers_le_bas).Select
            Selection.ClearContents
            Range("C4:H5").Select
            Selection.ClearContents
            ActiveSheet.Protect Password:="Terminal"
        ActiveWorkbook.Close
Workbooks.Open Filename:= _
"C:\Documents and Settings\Desktop\Camionnage\Matrice_Chauffeur.xls"
[COLOR="Blue"]Sheets("Lundi").Select
     ActiveSheet.Unprotect Password:="Terminal"
     Range("D3:M54").Select
     Selection.ClearContents
     Range("P3:T54").Select
     Selection.ClearContents
     ActiveSheet.Protect Password:="Terminal"
Sheets("Mardi").Select
     ActiveSheet.Unprotect Password:="Terminal"
     Range("D3:M54").Select
     Selection.ClearContents
     Range("P3:T54").Select
     Selection.ClearContents
     ActiveSheet.Protect Password:="Terminal"
Sheets("Mercredi").Select
     ActiveSheet.Unprotect Password:="Terminal"
     Range("D3:M54").Select
     Selection.ClearContents
     Range("P3:T54").Select
     Selection.ClearContents
     ActiveSheet.Protect Password:="Terminal"
Sheets("Jeudi").Select
     ActiveSheet.Unprotect Password:="Terminal"
     Range("D3:M54").Select
     Selection.ClearContents
     Range("P3:T54").Select
     Selection.ClearContents
     ActiveSheet.Protect Password:="Terminal"
Sheets("Vendredi").Select
     ActiveSheet.Unprotect Password:="Terminal"
     Range("D3:M54").Select
     Selection.ClearContents
     Range("P3:T54").Select
     Selection.ClearContents
     ActiveSheet.Protect Password:="Terminal"[/COLOR] 
Workbooks.Open Filename:= _
            "C:\Documents and Settings\Desktop\Camionnage\Matrice_Chauffeur2.xls"
             Application.DisplayAlerts = False
             Workbooks.Open Filename:= _
           "C:\Documents and Settings\Desktop\Camionnage\Matrice_Chauffeur.xls"
            ActiveWorkbook.Save
            Application.DisplayAlerts = True
            ActiveWorkbook.Close
            Workbooks.Open Filename:= _
           "C:\Documents and Settings\Desktop\Camionnage\Matrice_Chauffeur2.xls"
            Range("B3").Select
            Selection.ClearContents
            Range("C4:G5").Select
            ActiveSheet.Unprotect Password:="Terminal"
            Selection.ClearContents
            Range("A6:G35").Select
            Selection.ClearContents
     ActiveSheet.Protect Password:="Terminal"
     ActiveWorkbook.Save
     ActiveWorkbook.Close

Paritec · 18 Décembre 2009

Re : Archivage qui fonctionne mal

Bonjour Bricoltou
déjà tu peux retirer tous les select et tu as combien de feuilles dans ton classeur que lundi à vendredi?
si tu fournis un petit fichier tu auras plus de chance
a+
papou

JNP · 18 Décembre 2009

Re : Archivage qui fonctionne mal

Bonjour le fil ,
Essaie

Code:

Dim Feuille As Worksheet
For Each Feuille In ActiveWorkbook.Worksheets
Select Case Feuille.Name
Case "Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi"
With Feuille
.Unprotect Password:="Terminal"
.Range("D3:M54").ClearContents
.Range("P3:T54").ClearContents
.Protect Password:="Terminal"
End With
End Select
Next

Bonne journée

Bricoltou · 19 Décembre 2009

Re : Archivage qui fonctionne mal

Bonsoir le Fil , Paritec,JNP

Merci pour vos réponses vos codes fonctionne

Encore merci pour votre aide

Bricoltou

Archivage qui fonctionne mal

Bricoltou

XLDnaute Occasionnel

Paritec

XLDnaute Barbatruc

JNP

XLDnaute Barbatruc

Bricoltou

XLDnaute Occasionnel

Discussions similaires