voila le code complet
Sub Automatisation()
'
' Macro1 Macro
' Macro enregistrée le 14/09/2010
'
' Nommer les données de bases :
MonChemin = ActiveWorkbook.Path
NomFichierXls = ActiveWorkbook.Name
NomFichier = Left(NomFichierXls, Len(NomFichierXls) - 4)
' Selectionner Bassin :
Sheets("Base Travail").Select
Range("A2").Select
' Si cellule ="" (vide) alors arrêt de la Macro
Do Until ActiveCell = ""
cellule = ActiveCell.Address
Bassin = ActiveCell.Value
' Traitement Feuille ENTREES :
Sheets("ENTREES").Select
' Filtre sur Bassin :
Selection.AutoFilter Field:=5, Criteria1:=Bassin, Operator:=xlAnd
' Copie données visible uniquement sur nouvelle feuille
Range("A1:M1000").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Cells.Select
Cells.EntireColumn.AutoFit
Rows("2:2").Select
ActiveWindow.FreezePanes = True
Range("A1").Select
Sheets("Feuil1").Name = "ENTREES"
' Protection feuille
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Password:="sheridana", Scenarios:=True
' Enregistrement fichier généré (même chemin)
ActiveWorkbook.SaveAs Filename:=MonChemin & "\" & NomFichier & " " & Bassin & ".xls"
' Retour sur fichier de base
Windows(NomFichierXls).Activate
' Traitement Feuille SORTIES :
Sheets("SORTIES").Select
' Filtre sur Bassin :
Selection.AutoFilter Field:=5, Criteria1:=Bassin, Operator:=xlAnd
' Copie données visible uniquement sur feuille existante
Range("A1:M1000").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Windows(NomFichier & " " & Bassin & ".xls").Activate
Sheets("Feuil2").Select
ActiveSheet.Paste
Cells.Select
Cells.EntireColumn.AutoFit
Rows("2:2").Select
ActiveWindow.FreezePanes = True
Range("A1").Select
Sheets("Feuil2").Name = "SORTIES"
' Protection feuille
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Password:="sheridana", Scenarios:=True
' Retour sur fichier de base
Windows(NomFichierXls).Activate
' Traitement Feuille AVENANTS :
Sheets("AVENANTS").Select
' Filtre sur Bassin :
Selection.AutoFilter Field:=5, Criteria1:=Bassin, Operator:=xlAnd
' Copie données visible uniquement sur feuille existante
Range("A1:M1000").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Windows(NomFichier & " " & Bassin & ".xls").Activate
Sheets("Feuil3").Select
ActiveSheet.Paste
Cells.Select
Cells.EntireColumn.AutoFit
Rows("2:2").Select
ActiveWindow.FreezePanes = True
Range("A1").Select
Sheets("Feuil3").Name = "AVENANTS"
' Protection feuille
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Password:="sheridana", Scenarios:=True
Sheets.Add
Sheets("Feuil4").Select
Sheets("Feuil4").Move After:=Sheets(4)
' Retour sur fichier de base
Windows(NomFichierXls).Activate
' Traitement Feuille PER PROB :
Sheets("PER PROB").Select
' Filtre sur Bassin :
Selection.AutoFilter Field:=5, Criteria1:=Bassin, Operator:=xlAnd
' Copie données visible uniquement sur feuille existante
Range("A1:M1000").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Windows(NomFichier & " " & Bassin & ".xls").Activate
Sheets("Feuil4").Select
ActiveSheet.Paste
Cells.Select
Cells.EntireColumn.AutoFit
Rows("2:2").Select
ActiveWindow.FreezePanes = True
Range("A1").Select
Sheets("Feuil4").Name = "PER PROB"
' Protection feuille
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Password:="sheridana", Scenarios:=True
Sheets.Add
Sheets("Feuil5").Select
Sheets("Feuil5").Move After:=Sheets(5)
' Retour sur fichier de base
Windows(NomFichierXls).Activate
' Traitement Feuille CDD :
Sheets("CDD").Select
' Filtre sur Bassin :
Selection.AutoFilter Field:=5, Criteria1:=Bassin, Operator:=xlAnd
' Copie données visible uniquement sur feuille existante
Range("A1:M1000").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Windows(NomFichier & " " & Bassin & ".xls").Activate
Sheets("Feuil5").Select
ActiveSheet.Paste
Cells.Select
Cells.EntireColumn.AutoFit
Rows("2:2").Select
ActiveWindow.FreezePanes = True
Range("A1").Select
Sheets("Feuil5").Name = "CDD"
' Protection feuille
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Password:="sheridana", Scenarios:=True
Sheets.Add
Sheets("Feuil6").Select
Sheets("Feuil6").Move After:=Sheets(6)
' Retour sur fichier de base
Windows(NomFichierXls).Activate
' Traitement Feuille MISSION - AVT TEMP :
Sheets("MISSION - AVT TEMP").Select
' Filtre sur Bassin :
Selection.AutoFilter Field:=5, Criteria1:=Bassin, Operator:=xlAnd
' Copie données visible uniquement sur feuille existante
Range("A1:M1000").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Windows(NomFichier & " " & Bassin & ".xls").Activate
Sheets("Feuil6").Select
ActiveSheet.Paste
Cells.Select
Cells.EntireColumn.AutoFit
Rows("2:2").Select
ActiveWindow.FreezePanes = True
Range("A1").Select
Sheets("Feuil6").Name = "MISSION - AVT TEMP"
' Protection feuille
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Password:="sheridana", Scenarios:=True
Sheets.Add
Sheets("Feuil7").Select
Sheets("Feuil7").Move After:=Sheets(7)
' Retour sur fichier de base
Windows(NomFichierXls).Activate
' Traitement Feuille CHEQUE :
Sheets("CHEQUE").Select
' Filtre sur Bassin :
Selection.AutoFilter Field:=5, Criteria1:=Bassin, Operator:=xlAnd
' Copie données visible uniquement sur feuille existante
Range("A1:M1000").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Windows(NomFichier & " " & Bassin & ".xls").Activate
Sheets("Feuil7").Select
ActiveSheet.Paste
Cells.Select
Cells.EntireColumn.AutoFit
Rows("2:2").Select
ActiveWindow.FreezePanes = True
Range("A1").Select
Sheets("Feuil7").Name = "CHEQUE"
' Protection feuille
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Password:="sheridana", Scenarios:=True
' Enregistrement fichier généré (même chemin) écrasement du fichier crée juste avant sans message d'alerte
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=MonChemin & "\" & NomFichier & " " & Bassin & ".xls"
Application.ThisWorkbook.Saved = True
Application.DisplayAlerts = True
'ActiveWorkbook.SaveAs Filename:=MonChemin & "\" & NomFichier & " " & Bassin & ".xls"
'Fermeture du fichier créer
ActiveWindow.Close
Sheets("Base Travail").Select
Range(cellule).Select
' Descendre d'une case vers le bas et de 0 vers la droite pour gestion Bassin suivant
ActiveCell.Offset(1, 0).Select
Loop
' Enlever le filtre sur chaque onglet :
Sheets("ENTREES").Select
Selection.AutoFilter Field:=5
Range("A1").Select
Sheets("SORTIES").Select
Selection.AutoFilter Field:=5
Range("A1").Select
Sheets("AVENANTS").Select
Selection.AutoFilter Field:=5
Range("A1").Select
Sheets("PER PROB").Select
Selection.AutoFilter Field:=5
Range("A1").Select
Sheets("CDD").Select
Selection.AutoFilter Field:=5
Sheets("MISSION - AVT TEMP").Select
Selection.AutoFilter Field:=5
Range("A1").Select
Sheets("CHEQUE").Select
Selection.AutoFilter Field:=5
Range("A1").Select
Sheets("Base Travail").Select
Range("A2").Select
MsgBox ("La Génération est Terminée")
End Sub