bodiallo
XLDnaute Nouveau
je me suis inspire de plusieurs bouts de code pour me batir ce code.
Il vérifie si la feuillet à dupliquer existe, si vrai duplique la feuille dans le même classeur. j'insère dans la cellule C3 la date du mois précédent et jusque là il n'y a pas de problème. vue que le nombre de jour de chaque mois varie, je parcours la ligne de ma nouvelle feuille en vérifiant si le mois de cellule C3 et identique aux autres cellules sinon supprime la colonne contenant le mois différent du mois de C3. c'est là que commence mes difficultés, il me supprime ces colonnes sur la feuille original. et depuis je ne parviens pas à corriger cela. je joins mon classeur pour plus de compréhension.
je demande votre apport pour rectifier mon ou mes erreurs.
voici mon code
Il vérifie si la feuillet à dupliquer existe, si vrai duplique la feuille dans le même classeur. j'insère dans la cellule C3 la date du mois précédent et jusque là il n'y a pas de problème. vue que le nombre de jour de chaque mois varie, je parcours la ligne de ma nouvelle feuille en vérifiant si le mois de cellule C3 et identique aux autres cellules sinon supprime la colonne contenant le mois différent du mois de C3. c'est là que commence mes difficultés, il me supprime ces colonnes sur la feuille original. et depuis je ne parviens pas à corriger cela. je joins mon classeur pour plus de compréhension.
je demande votre apport pour rectifier mon ou mes erreurs.
voici mon code
Code:
Public Function FeuilleExiste(FeuilleAVerifier As String) As Boolean
'fonction qui vérifie si la "FeuilleActive" existe dans le Classeur actif
On Error GoTo SiErreur
Dim Feuille As Worksheet
Dim SheetName As String
SheetName = ActiveWorkbook.ActiveSheet.Name
FeuilleExiste = False
For Each Feuille In Worksheets
If Feuille.Name = SheetName Then
FeuilleExiste = True
Exit Function
End If
Next Feuille
Exit Function
SiErreur:
MsgBox "Une erreur s'est produite..."
FeuilleExiste = CVErr(xlErrNA)
End Function
Sub Test()
'Utilisation de la fonction "FeuilleExiste" puis ajout d'une nouvelle feuille
Dim SheetName As String
Dim i As Integer
SheetName = ActiveWorkbook.ActiveSheet.Name
If FeuilleExiste(SheetName) = True Then
'MsgBox "La Feuille " & SheetName & " existe !"
'ajoute uen Feuille tout à la fin du Classeur en comptant les Feuilles avec la méthode Worksheets.Count et la nommée
'Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = Format(Date - 2, "mmmm") & "-" & Format(Date, "yy") & "_KPI "
Sheets(SheetName).Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = Format(Date + 14, "mmmm") & "-" & Format(Date, "yy") & "_KPI "
'entre la date du 1er jour du mois en cours dans la cellule C3
ActiveSheet.Range("C3") = DateSerial(Year(Date), Month(Date) + 1, 1)
'recuperation du numéro de colonne de la cellule contenant la date du dernier jour du mois en cours numérodecolonnedelacelluleactive ActiveCell.column
'DerniereColonneUtilisee = Cells(3, Columns.Count).End(xlToLeft).Column 'où 3 est le numéro de la ligne
For Each cell In ActiveSheet.Range("C3:AG3")
If Month(cell.Value) <> Month(ActiveSheet.Range("C3")) Then
i = cell.Column
Columns(Val(i)).Delete Shift:=xlToLeft
End If
Next
Else
MsgBox "La Feuille 'Test_1' n'existe pas!"
End If
End Sub