Bonjour à tous,
Après mettre balader sur la toile et arracher les cheveux
, je ne trouve toujours pas de solution a mon probleme!
J'ai un fichier planning, une feuille correspond à 1 semaine (nom= "S"et"n°semaine"). Les infos de chaque feuille sont renseignées à partir d'une extraction logiciel. jusque là tout va bien. Le truc c'est que une fois la date de l'extraction passée, il ne me reste aucune trace des actions réalisées antérieurement.
Au départ, je voulais donc "figer les feuilles" quand la date est inférieur à celle de l'extraction, je n'ai pas réussi.
J'ai donc créé un fichier "archive" qui copie/colle les valeurs de ces feuilles et les supprime ensuite.
Voici le code:
sub Archivage()
' Archivage Macro
Archive = "Archive_planning_2012" & ".xlsx"
Var_Chemin2 = "C:\Users\Utilisateur\Documents\Fab_ne_pas_sup\" & Archive
FichierPlanning = "Planning_2012" & ".xlsm"
'Ouverture fichier Archive
On Error Resume Next
Workbooks.Open Var_Chemin2, 0, ReadOnly:=False
If Err <> 0 Then
Sheets("A1").Select
Unload UserForm1
Application.ScreenUpdating = True
MsgBox "Vérifier "
Exit Sub
End If
On Error GoTo 0
'Archivage des semaines passées
Windows(FichierPlanning).Activate
For Each Sh In Sheets
If Sh.Name Like "S*" Then
If Range("B2").Value < Sheets("extractionAPO").Range("P1").Value Then
Cells.Select
Selection.Copy
Windows(Archive).Activate
Sheets.Add After:=Sheets(Sheets.Count)
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
ActiveSheet.Name = "S" & Range("B1")
Application.DisplayAlerts = False
Workbooks(FichierPlanning).ActiveSheet.Delete
Application.DisplayAlerts = True
End If
End If
Next
'Fermeture fichier archive
Workbooks(Archive).Save
Windows(Archive).Close
End Sub
Le truc c'est que mon code marche tellement bien qu'il me supprime même les feuilles "autres" genre feuille "Modop", "Listes", etc.. ou sinon il ne marche pas! ca dépend!
Pouvez vous m'aidez et me dire d'où vient le pb? je ne peux pas cumuler les fonctions "if" comme ça?
Pour vous éclairer je vous joint un exemple de fichier. Il devrait donc me supprimer les feuilles 'S13', 'S14' et 'S33'.
Par avance un grand merci pour votre aide!
Après mettre balader sur la toile et arracher les cheveux
, je ne trouve toujours pas de solution a mon probleme!J'ai un fichier planning, une feuille correspond à 1 semaine (nom= "S"et"n°semaine"). Les infos de chaque feuille sont renseignées à partir d'une extraction logiciel. jusque là tout va bien. Le truc c'est que une fois la date de l'extraction passée, il ne me reste aucune trace des actions réalisées antérieurement.
Au départ, je voulais donc "figer les feuilles" quand la date est inférieur à celle de l'extraction, je n'ai pas réussi.
J'ai donc créé un fichier "archive" qui copie/colle les valeurs de ces feuilles et les supprime ensuite.
Voici le code:
sub Archivage()
' Archivage Macro
Archive = "Archive_planning_2012" & ".xlsx"
Var_Chemin2 = "C:\Users\Utilisateur\Documents\Fab_ne_pas_sup\" & Archive
FichierPlanning = "Planning_2012" & ".xlsm"
'Ouverture fichier Archive
On Error Resume Next
Workbooks.Open Var_Chemin2, 0, ReadOnly:=False
If Err <> 0 Then
Sheets("A1").Select
Unload UserForm1
Application.ScreenUpdating = True
MsgBox "Vérifier "
Exit Sub
End If
On Error GoTo 0
'Archivage des semaines passées
Windows(FichierPlanning).Activate
For Each Sh In Sheets
If Sh.Name Like "S*" Then
If Range("B2").Value < Sheets("extractionAPO").Range("P1").Value Then
Cells.Select
Selection.Copy
Windows(Archive).Activate
Sheets.Add After:=Sheets(Sheets.Count)
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
ActiveSheet.Name = "S" & Range("B1")
Application.DisplayAlerts = False
Workbooks(FichierPlanning).ActiveSheet.Delete
Application.DisplayAlerts = True
End If
End If
Next
'Fermeture fichier archive
Workbooks(Archive).Save
Windows(Archive).Close
End Sub
Le truc c'est que mon code marche tellement bien qu'il me supprime même les feuilles "autres" genre feuille "Modop", "Listes", etc.. ou sinon il ne marche pas! ca dépend!
Pouvez vous m'aidez et me dire d'où vient le pb? je ne peux pas cumuler les fonctions "if" comme ça?
Pour vous éclairer je vous joint un exemple de fichier. Il devrait donc me supprimer les feuilles 'S13', 'S14' et 'S33'.
Par avance un grand merci pour votre aide!
