Voilà la bête, avec une boucle qui ouvrent tous les fichiers d'un répertoire (merci à http://vlohr.free.fr )
Sub Boucle_sur_fichier()
'Application.ScreenUpdating = False
Dim Cherche As Variant
Dim Boucle As Variant
Set Cherche = Application.FileSearch
With Cherche
.LookIn = "C:\data\g8_\fdp\"
.FileName = "*.xls"
If .Execute > 0 Then
For Boucle = 1 To .FoundFiles.Count
Workbooks.OpenText FileName:=.FoundFiles(Boucle), Origin:=xlMSDOS, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
Array(3, 1), Array(4, 2), Array(5, 1), Array(6, 1))
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$9"
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = "&P/&N"
.RightFooter = "&F &D"
.LeftMargin = Application.InchesToPoints(0.196850393700787)
.RightMargin = Application.InchesToPoints(0.196850393700787)
.TopMargin = Application.InchesToPoints(0.393700787401575)
.BottomMargin = Application.InchesToPoints(0.590551181102362)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.31496062992126)
.PrintHeadings = False
.PrintGridlines = True
.PrintComments = xlPrintNoComments
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
End With
Columns("A:A").Select
Selection.ColumnWidth = 30
Columns("B:B").Select
Selection.ColumnWidth = 7
Columns("C:C").Select
Selection.ColumnWidth = 5
Columns("D:D").Select
Selection.ColumnWidth = 10
Columns("E:E").Select
Selection.ColumnWidth = 12
Columns("F:F").Select
Selection.ColumnWidth = 55
Cells.Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
With Selection.Font
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With Selection.Font
.Name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("A8").Select
Selection.Font.Bold = True
Rows("9:9").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
Selection.Font.Bold = True
Rows("10:200").Select
Selection.RowHeight = 30
Range("A9").Select
If a10 <> "" Then
Selection.Sort Key1:=Range("B10"), Order1:=xlDescending, Key2:=Range( _
"A10"), Order2:=xlAscending, Key3:=Range("D10"), Order3:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
xlTopToBottom
Else
End If
Range("A10").Select
While ActiveCell.Value <> ""
Dim nom As String
Dim refnom As Range
If ActiveCell.Value = nom Then
Range(ActiveCell + 1).Select
Else
Range(Cells(refnom.Row, 1), Cells(ActiveCell.Row, 6)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
End If
Wend
Range("B2").Select
Selection.ClearContents
Range("A1").Select
Next Boucle
End If
End With
End Sub