ConsultantJP
XLDnaute Occasionnel
Bonjour à tous,
J'ai crée un code VBA, un per anarchique à mon gout mais qui fonctionne très bien malgrès un petit bug dont je connais l'origine :
Mon code a pour objectif de filtrer des donnés sur une feuille d'aller filtrer en fonction du mois de faire un copier coller sur un autre classeur , et cela sur 4 feuilles différentes.
=> le problème est que si je n'ai pas de données dans une des feuilles ça bug, il faudrait que je puisse passer à la feuille suivante si le mois n'est pas présent dans la feuille.
De la meme maniere, dans le fichier en question, j'ai une boucle qui va dans x fichiers supprimer les donnés qui sont filtrés, et donc bug identique.
Voici mon code (par contre dsl, impossible de joindre le fichier car il trop lourd et confidentiel).
Si vous avez une idée ou si vous pouviez m'aiquiller, je vous en remercie bcp par avance!!
J'ai crée un code VBA, un per anarchique à mon gout mais qui fonctionne très bien malgrès un petit bug dont je connais l'origine :
Mon code a pour objectif de filtrer des donnés sur une feuille d'aller filtrer en fonction du mois de faire un copier coller sur un autre classeur , et cela sur 4 feuilles différentes.
=> le problème est que si je n'ai pas de données dans une des feuilles ça bug, il faudrait que je puisse passer à la feuille suivante si le mois n'est pas présent dans la feuille.
De la meme maniere, dans le fichier en question, j'ai une boucle qui va dans x fichiers supprimer les donnés qui sont filtrés, et donc bug identique.
Voici mon code (par contre dsl, impossible de joindre le fichier car il trop lourd et confidentiel).
Si vous avez une idée ou si vous pouviez m'aiquiller, je vous en remercie bcp par avance!!
Code:
Sub FORMATAGE()
Dim MyFile, MyRep, MyOldFile
MOI = ActiveWorkbook.Name
'
' On affiche le message d'attente
frm_Message.Show
frm_Message.Repaint
' On masque les traitements
Application.ScreenUpdating = False
' On récupère le chemin du fichier SYNTHESE
For w = 1 To Sheets.Count
If InStr(UCase(Workbooks(w).Name), "SYNTHESE SUIVI ACTIVIT") > 0 Then
MyRep = Workbooks(w).Path & IIf(Right(Workbooks(w).Path, 1) <> "\", "\", "")
Exit For
End If
Next w
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Suppression des données de la synthèse et enregistrement dans le fichier archive'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'on paramètre le fichier d'archive à ouvrir
myreparchive = MyRep & "Archive\"
MyFile = Dir(myreparchive & "Archive gestionnaire.xls")
MyOldFile = Dir(myreparchive & "Archive Données Gestionnaires" & " - " & frm_Mois.ComboBoxMois.Value & ".xls")
'on vérifie si un fichier de sauvegarde pour le mois n'a pas déjà été créé
If Dir(myreparchive & "Archive Données Gestionnaires" & " - " & frm_Mois.ComboBoxMois.Value & ".xls") <> "" Then
'si oui, on va ouvrir le fichier en question, et sélectionner les dernières lignes de chaques fichier
Workbooks.Open Filename:=myreparchive & "Archive Données Gestionnaires" & " - " & frm_Mois.ComboBoxMois.Value & ".xls"
FichierArchive = ActiveWorkbook.Name
Set wbarchive = Workbooks(MyOldFile)
Set wsArchiveCE = wbarchive.Worksheets("Charge Entrante")
Set wsArchiveAN = wbarchive.Worksheets("Contrôles")
Set wsArchiveMail = wbarchive.Worksheets("NonConformité")
Set wsArchivePertes = wbarchive.Worksheets("Suivi Pertes et Profits")
intligneArchiveCE = 1
'on récupère la dernière ligne de synthèse CE du fichier d'archive
Do While wsArchiveCE.Cells(intligneArchiveCE, 1) <> ""
intligneArchiveCE = intligneArchiveCE + 1
Loop
intligneArchiveAN = 1
'on récupère la dernière ligne de synthèse AN du fichier d'archive
Do While wsArchiveAN.Cells(intligneArchiveAN, 1) <> ""
intligneArchiveAN = intligneArchiveAN + 1
Loop
intligneArchiveMail = 1
'on récupère la dernière ligne de synthèse AN du fichier d'archive
Do While wsArchiveMail.Cells(intligneArchiveMail, 1) <> ""
intligneArchiveMail = intligneArchiveMail + 1
Loop
intligneArchivePertes = 1
'on récupère la dernière ligne de synthèse AN du fichier d'archive
Do While wsArchivePertes.Cells(intligneArchivePertes, 1) <> ""
intligneArchivePertes = intligneArchivePertes + 1
Loop
'je repasse sur le fichier de synthèse d'activités
Windows(MOI).Activate
' On sélectionne la feuille charge entrante dans le fichier de synthèse
ActiveWorkbook.Sheets("Charges Entrantes").Activate
'on sélectionne toutes les cellules
ActiveWorkbook.Sheets("Charges Entrantes").Cells.Select
'on met en place un filtre automatique avec comme critère la date choisie par le RE
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:="" & frm_Mois.ComboBoxMois.Value
'On se place sur la cellule A2
ActiveSheet.Range("A2").Select
If ActiveSheet.Range("A2").Value <> "" Then
'on sélectionne toutes les données de la colone A filtrée
ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
'on sélectionne toutes les lignes et on les copy
Selection.EntireRow.Copy
End If
Windows(FichierArchive).Activate
'on repasse sur l'onglet de synthèse
wsArchiveCE.Activate
ActiveSheet.Cells(intligneArchiveCE, 1).Select
ActiveSheet.Paste
Windows(MOI).Activate
' On sélectionne la feuille charge entrante dans le fichier de synthèse
ActiveWorkbook.Sheets("Contrôles").Activate
'on sélectionne toutes les cellules
ActiveWorkbook.Sheets("Contrôles").Cells.Select
'on met en place un filtre automatique avec comme critère la date choisie par le RE
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:="" & frm_Mois.ComboBoxMois.Value
'On se place sur la cellule A2
ActiveSheet.Range("A2").Select
If ActiveSheet.Range("A2").Value <> "" Then
'on sélectionne toutes les données de la colone A filtrée
ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
'on sélectionne toutes les lignes et on les supprime
Selection.EntireRow.Copy
End If
Windows(FichierArchive).Activate
'on repasse sur l'onglet de synthèse
wsArchiveAN.Activate
ActiveSheet.Cells(intligneArchiveAN, 1).Select
ActiveSheet.Paste
Windows(MOI).Activate
''''''''''''''''''''''''''''''
' On sélectionne la feuille charge entrante dans le fichier de synthèse
ActiveWorkbook.Sheets("NonConformité").Activate
'on sélectionne toutes les cellules
ActiveWorkbook.Sheets("NonConformité").Cells.Select
'on met en place un filtre automatique avec comme critère la date choisie par le RE
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:="" & frm_Mois.ComboBoxMois.Value
'On se place sur la cellule A2
ActiveSheet.Range("A2").Select
If ActiveSheet.Range("A2").Value <> "" Then
'on sélectionne toutes les données de la colone A filtrée
ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
'on sélectionne toutes les lignes et on les supprime
Selection.EntireRow.Copy
End If
Windows(FichierArchive).Activate
'on repasse sur l'onglet de synthèse
wsArchiveMail.Activate
ActiveSheet.Cells(intligneArchiveMail, 1).Select
ActiveSheet.Paste
Windows(MOI).Activate
''''''''''''''''''''''''''''''''''''''
' On sélectionne la feuille charge entrante dans le fichier de synthèse
ActiveWorkbook.Sheets("Suivi Pertes et Profits").Activate
'on sélectionne toutes les cellules
ActiveWorkbook.Sheets("Suivi Pertes et Profits").Cells.Select
'on met en place un filtre automatique avec comme critère la date choisie par le RE
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:="" & frm_Mois.ComboBoxMois.Value
'On se place sur la cellule A2
ActiveSheet.Range("A2").Select
If ActiveSheet.Range("A2").Value <> "" Then
'on sélectionne toutes les données de la colone A filtrée
ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
'on sélectionne toutes les lignes et on les supprime
Selection.EntireRow.Copy
End If
Windows(FichierArchive).Activate
'on repasse sur l'onglet de synthèse
wsArchivePertes.Activate
ActiveSheet.Cells(intligneArchivePertes, 1).Select
ActiveSheet.Paste
ActiveWorkbook.Save
ActiveWorkbook.Close
'sinon on commence la copie et on ouvrira le fichier modèle ensuite pour l'enregistrer
Else
Workbooks.Open myreparchive & MyFile, ReadOnly:=False
FichierArchive = ActiveWorkbook.Name
Set wbarchive = Workbooks(FichierArchive)
Set wsArchiveCE = wbarchive.Worksheets("Charge Entrante")
Set wsArchiveAN = wbarchive.Worksheets("Contrôles")
Set wsArchiveMail = wbarchive.Worksheets("NonConformité")
Set wsArchivePertes = wbarchive.Worksheets("Suivi Pertes et Profits")
intligneArchiveCE = 1
'on récupère la dernière ligne de synthèse CE du fichier d'archive
Do While wsArchiveCE.Cells(intligneArchiveCE, 1) <> ""
intligneArchiveCE = intligneArchiveCE + 1
Loop
intligneArchiveAN = 1
'on récupère la dernière ligne de synthèse AN du fichier d'archive
Do While wsArchiveAN.Cells(intligneArchiveAN, 1) <> ""
intligneArchiveAN = intligneArchiveAN + 1
Loop
intligneArchiveMail = 1
'on récupère la dernière ligne de synthèse AN du fichier d'archive
Do While wsArchiveMail.Cells(intligneArchiveMail, 1) <> ""
intligneArchiveMail = intligneArchiveMail + 1
Loop
intligneArchivePertes = 1
'on récupère la dernière ligne de synthèse AN du fichier d'archive
Do While wsArchivePertes.Cells(intligneArchivePertes, 1) <> ""
intligneArchivePertes = intligneArchivePertes + 1
Loop
'je repasse sur le fichier de synthèse d'activités
Windows(MOI).Activate
' On sélectionne la feuille charge entrante dans le fichier de synthèse
ActiveWorkbook.Sheets("Charges Entrantes").Activate
'on sélectionne toutes les cellules
ActiveWorkbook.Sheets("Charges Entrantes").Cells.Select
'on met en place un filtre automatique avec comme critère la date choisie par le RE
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:="" & frm_Mois.ComboBoxMois.Value
'On se place sur la cellule A2
ActiveSheet.Range("A2").Select
If ActiveSheet.Range("A2").Value <> "" Then
'on sélectionne toutes les données de la colone A filtrée
ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
'on sélectionne toutes les lignes et on les copy
Selection.EntireRow.Copy
End If
Windows(FichierArchive).Activate
'on repasse sur l'onglet de synthèse
wsArchiveCE.Activate
ActiveSheet.Cells(intligneArchiveCE, 1).Select
ActiveSheet.Paste
Windows(MOI).Activate
' On sélectionne la feuille charge entrante dans le fichier de synthèse
ActiveWorkbook.Sheets("Contrôles").Activate
'on sélectionne toutes les cellules
ActiveWorkbook.Sheets("Contrôles").Cells.Select
'on met en place un filtre automatique avec comme critère la date choisie par le RE
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:="" & frm_Mois.ComboBoxMois.Value
'On se place sur la cellule A2
ActiveSheet.Range("A2").Select
If ActiveSheet.Range("A2").Value <> "" Then
'on sélectionne toutes les données de la colone A filtrée
ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
'on sélectionne toutes les lignes et on les supprime
Selection.EntireRow.Copy
End If
Windows(FichierArchive).Activate
'on repasse sur l'onglet de synthèse
wsArchiveAN.Activate
ActiveSheet.Cells(intligneArchiveAN, 1).Select
ActiveSheet.Paste
Windows(MOI).Activate
''''''''''''''''''''''''''''''
' On sélectionne la feuille charge entrante dans le fichier de synthèse
ActiveWorkbook.Sheets("NonConformité").Activate
'on sélectionne toutes les cellules
ActiveWorkbook.Sheets("NonConformité").Cells.Select
'on met en place un filtre automatique avec comme critère la date choisie par le RE
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:="" & frm_Mois.ComboBoxMois.Value
'On se place sur la cellule A2
ActiveSheet.Range("A2").Select
If ActiveSheet.Range("A2").Value <> "" Then
'on sélectionne toutes les données de la colone A filtrée
ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
'on sélectionne toutes les lignes et on les supprime
Selection.EntireRow.Copy
End If
Windows(FichierArchive).Activate
'on repasse sur l'onglet de synthèse
wsArchiveMail.Activate
ActiveSheet.Cells(intligneArchiveMail, 1).Select
ActiveSheet.Paste
Windows(MOI).Activate
''''''''''''''''''''''''''''''''''''''
' On sélectionne la feuille charge entrante dans le fichier de synthèse
ActiveWorkbook.Sheets("Suivi Pertes et Profits").Activate
'on sélectionne toutes les cellules
ActiveWorkbook.Sheets("Suivi Pertes et Profits").Cells.Select
'on met en place un filtre automatique avec comme critère la date choisie par le RE
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:="" & frm_Mois.ComboBoxMois.Value
'On se place sur la cellule A2
ActiveSheet.Range("A2").Select
If ActiveSheet.Range("A2").Value <> "" Then
'on sélectionne toutes les données de la colone A filtrée
ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
'on sélectionne toutes les lignes et on les supprime
Selection.EntireRow.Copy
End If
' on repasse sur l'onglet de synthèse
wsArchivePertes.Activate
ActiveSheet.Cells(intligneArchivePertes, 1).Select
ActiveSheet.Paste
Windows(FichierArchive).Activate
'on enregistre le nouveau fichier avec comme extension le mois dont on a archivé les données
ActiveWorkbook.SaveAs Filename:=myreparchive & "Archive Données Gestionnaires" & " - " & frm_Mois.ComboBoxMois.Value & ".xls"
'on ferme le fichier créé
ActiveWorkbook.Close
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Suppression des données dans les fichiers gestionnaires'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' On paramètre les noms des fichiers à ouvrir
MyFile = Dir(MyRep & "Suivi d'Activité *.xls")
Do While MyFile <> "" ' Commence la boucle.
Workbooks.Open MyRep & MyFile, ReadOnly:=False
' On reférence le classeur et la feuille Distante
Set wbGest = Workbooks(MyFile)
Set wsGestCE = wbGest.Worksheets("Charge Entrante")
Set wsGestAN = wbGest.Worksheets("Contrôles")
Set wsGestMail = wbGest.Worksheets("NonConformité")
Set wsGestPertes = wbGest.Worksheets("Suivi Pertes et Profits")
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Suppression des données dans la feuille Charge entrante'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' On sélectionne la feuille charge entrante dans le fichier des gestionnaires
wsGestCE.Activate
'on sélectionne toutes les cellules
wsGestCE.Cells.Select
'on met en place un filtre automatique avec comme critère la date choisie par le RE
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:="" & frm_Mois.ComboBoxMois.Value
'On se place sur la cellule A2
ActiveSheet.Range("A2").Select
If ActiveSheet.Range("A2").Value <> "" Then
'on sélectionne toutes les données de la colone A filtrée
ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
'on sélectionne toutes les lignes et on les supprime
Selection.EntireRow.Delete
End If
'on resélectionne l'ensemble des cellules
wsGestCE.Cells.Select
'on enlève le filtre automatique
Selection.AutoFilter
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Suppresion des données dans la feuille Activités Annexes'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' On sélectionne la feuille charge entrante dans le fichier des gestionnaires
wsGestAN.Activate
'on sélectionne toutes les cellule
wsGestAN.Cells.Select
'on met en place un filtre automatique avec comme critère la date choisie par le RE
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:="" & frm_Mois.ComboBoxMois.Value
'On se place sur la cellule A2
ActiveSheet.Range("A2").Select
If ActiveSheet.Range("A2").Value <> "" Then
'on sélectionne toutes les données de la colone A filtrée
ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
'on sélectionne toutes les lignes et on les supprime
Selection.EntireRow.Delete
End If
'on resélectionne l'ensemble des cellules
wsGestAN.Cells.Select
'on enlève le filtre automatique
Selection.AutoFilter
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Suppresion des données dans la feuille Activités MAILS
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' On sélectionne la feuille charge entrante dans le fichier des gestionnaires
wsGestMail.Activate
'on sélectionne toutes les cellule
wsGestMail.Cells.Select
'on met en place un filtre automatique avec comme critère la date choisie par le RE
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:="" & frm_Mois.ComboBoxMois.Value
'On se place sur la cellule A2
ActiveSheet.Range("A2").Select
If ActiveSheet.Range("A2").Value <> "" Then
'on sélectionne toutes les données de la colone A filtrée
ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
'on sélectionne toutes les lignes et on les supprime
Selection.EntireRow.Delete
End If
'on resélectionne l'ensemble des cellules
wsGestMail.Cells.Select
'on enlève le filtre automatique
Selection.AutoFilter
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Suppresion des données dans la feuille Activités MAILS
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' On sélectionne la feuille charge entrante dans le fichier des gestionnaires
wsGestPertes.Activate
'on sélectionne toutes les cellule
wsGestPertes.Cells.Select
'on met en place un filtre automatique avec comme critère la date choisie par le RE
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:="" & frm_Mois.ComboBoxMois.Value
'On se place sur la cellule A2
ActiveSheet.Range("A2").Select
If ActiveSheet.Range("A2").Value <> "" Then
'on sélectionne toutes les données de la colone A filtrée
ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
'on sélectionne toutes les lignes et on les supprime
Selection.EntireRow.Delete
End If
'on resélectionne l'ensemble des cellules
wsGestPertes.Cells.Select
'on enlève le filtre automatique
Selection.AutoFilter
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Enregistrement et fermeture du fichier des gestionnaires'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' On sélectionne la feuille MENU
wbGest.Worksheets("Menu").Select
' On quitte en sauvegardant
wbGest.Close savechanges:=True
MyFile = Dir
Loop
Windows(MOI).Activate
Sheets("Menu").Select
Sheets("Charges Entrantes").Activate
Rows("1:1").Select
Selection.AutoFilter
Rows("2:2").Select
Selection.EntireRow.Hidden = True
Sheets("Contrôles").Activate
Rows("1:1").Select
Selection.AutoFilter
Rows("2:2").Select
Selection.EntireRow.Hidden = True
Sheets("NonConformité").Activate
Rows("1:1").Select
Selection.AutoFilter
Rows("2:2").Select
Selection.EntireRow.Hidden = True
Sheets("Suivi Pertes et Profits").Activate
Rows("1:1").Select
Selection.AutoFilter
Rows("2:2").Select
Selection.EntireRow.Hidden = True
Sheets("Menu").Select
' On masque le message d'attente
Unload frm_Message
Synthèse
'Affichage de la confirmation de l'archivage des données
MsgBox "Les données ont été archivées dans le dossier " & myreparchive & ". Elles ont été supprimées des fichiers des gestionnaires et la synthèse à été mise à jour."
End Sub
Dernière édition:
