Excel - Comment simplifier automatiser ce code VBA?

Bonjour,

Je suis d?butant en VBA, je voulais d?j? remerci? MichD d'avoir r?pondu ? un
post il y a quelque jour ce qui m'a beaucoup aid? ? avanc?.

Je cherche une piste pour simplifier mon code, et ? le rendre plus mall?able
quant aux modifications qui peuvent ?tre faites.

Je dois diffuser des donn?es ? des agences, j'ai 180 onglets, et 60 agences
dans un m?me fichier xlsx.

Le code ci dessous marche pour une agence d?termin?e, avec des onglets
d?termin?es et l'enregistrement ? un endroit d?termin?.

S?lectionner les onglets que je souhaite
L'enregistrer ? un nom sp?cifique au format .xlsx
L'enregistrer ? un endroit donn?
l'enregistrer au format pdf

Mais si je dois rajouter le reste des agences? avec des nouveaux onglets
comment vais je faire? recopier tel quel la formule et changer la destination
etc, mais avec 180 onglets et 60 agences la formule va faire des kilometres !
Ni a t-il pas une solution moins longue?
Est il possible de lui mettre dans une feuille
Colonne A: Nom des onglet
Colonne B: Nom du fichier
Colonne C: l'endroit ou l'enregistr? et que la macro agisse en fonction de ces
infos, le code serait beaucoup plus court.

Avez vous un piste, un conseil?
Merci d'avance !!

Sub test()
Application.DisplayAlerts = False
Sheets(Array("Agence ALSACE", "Agence ALSACE (2)", "Agence ALSACE (3)")).Copy
ActiveWorkbook.SaveAs "N:\Litiges\Test Automat\Litiges Agence ALSACE.xlsx"

Dim i As Integer
With ActiveWorkbook
For i = 1 To Sheets.Count
With Sheets(i).Cells
.Columns.AutoFit
.Rows.AutoFit
.Cells.Locked = False
.Range("B2").Locked = True
End With
Next i

ActiveWorkbook.Worksheets.Select
For Each xworksheet In ActiveWorkbook.Worksheets
xworksheet.Select
Range("F:F").ColumnWidth = 170
Range("F:F").WrapText = True

With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$4"
.PrintArea = "$A$4:$H$51"
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0.5)
.BottomMargin = Application.InchesToPoints(0)
.FitToPagesWide = 1
.FitToPagesTall = 1
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.Orientation = xlLandscape
.Zoom = False
End With
Next xworksheet

'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="N:\Litiges\Test Automat\Agence ALSACE.pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
MsgBox "Fiche cr?e et database mise ? jour"
End With

ActiveWorkbook.Close False

End Sub

bonjour anthooooony,


Sub test()
Dim i As Integer

With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With

Sheets(Array("Agence ALSACE", "Agence ALSACE (2)", "Agence ALSACE (3)")).Copy
ActiveWorkbook.SaveAs "N:\Litiges\Test Automat\Litiges Agence ALSACE.xlsx"


With ActiveWorkbook

For i = 1 To .Sheets.Count
With .Sheets(i)

With .Cells
.Columns.AutoFit
.Rows.AutoFit
.Cells.Locked = False
.Range("B2").Locked = True
End With


.Range("F:F").ColumnWidth = 170
.Range("F:F").WrapText = True

With .PageSetup
.PrintTitleRows = "$1:$4"
.PrintArea = "$A$4:$H$51"
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0.5)
.BottomMargin = Application.InchesToPoints(0)
.FitToPagesWide = 1
.FitToPagesTall = 1
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.Orientation = xlLandscape
.Zoom = False
End With

End With
Next i

'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="N:\Litiges\Test Automat\Agence ALSACE.pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False

End With

MsgBox "Fiche cr?e et database mise ? jour"
ActiveWorkbook.Close False

With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub


--
isabelle