Dim Nomfeuille, FeuilleOrigine, Mois(), M%, Début%, Fin%
On Error GoTo FinArchive
Application.ScreenUpdating = False
' Nom de la nouvelle archive
FeuilleOrigine = ActiveSheet.Name
Nomfeuille = InputBox("Quel nom voulez vous donner à l'archive ?", vbYesNo)
If Nomfeuille = "" Then Exit Sub
' Duplication de la feuille, renommage, copier coller valeur, et masquage.
ActiveWorkbook.ActiveSheet.Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = Nomfeuille
Columns("C:AG").Select
Range("C2").Activate
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
[B1].Select
ActiveSheet.Visible = 0
' On revient sur la feuille d'origine et on efface les données.
Sheets(FeuilleOrigine).Select
Mois = Array("JANVIER", "FEVRIER", "MARS", "AVRIL", "MAI", "JUIN", "JUILLET", "AOUT", "SEPTEMBRE", "OCTOBRE", "NOVEMBRE", "DECEMBRE", "FIN")
For M = 0 To 11
Nom = Mois(M)
Début = Application.Match(Mois(M), [C:C], 0) + 2 ' Zone à effacer commence 2 lignes après le mois
If M < 11 Then
Fin = Application.Match(Mois(M + 1), [C:C], 0) - 1 ' et se termine 1 ligne avant le mois suivant
Else
Fin = 400 ' Si mois de décembre, pas de mois suivant donc Fin=400
End If
Range("D" & Début & ":K" & Fin).ClearContents
Next M
' Message de fin
MsgBox "Cette feuille a été archivée sous le nom de " & Nomfeuille & Chr(10) & " et a été masquée."
Exit Sub
FinArchive:
' si le nom de l'archive existe déjà, alors erreur.
MsgBox "Oups! petit souci, la feuille avec ce nom semble déjà exister."
End Sub
