1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45
|
Sub Macro_Zoom()
Dim ListeTitre()
Dim ListeParam()
Dim WsSource As Worksheet
Dim WsCible As Workbook
Dim xlApp As Excel.Application
Dim xlBook As Workbook
Dim xlSheet As Worksheet
Set WsSource = ThisWorkbook.Worksheets("Final")
ListeParam = Array("AUTO", "DAB CORPORATE", "DAB DOMESTIQUE", "DC", "NR", "RC", "TRAN")
ListeParam2 = Array("DIRECT", "EDW")
With WsSource
For i = LBound(ListeParam) To UBound(ListeParam)
For j = LBound(ListeParam2) To UBound(ListeParam2)
Set c = Nothing
Set c = .Rows(1).Find("TRAITE", , xlValues, xlWhole)
If Not c Is Nothing Then .Range("A1").AutoFilter c.Column, ListeParam(i), xlFilterValues
Set b = Nothing
Set b = .Rows(1).Find("DIRECT/EDW", , xlValues, xlWhole)
If Not b Is Nothing Then .Range("A1").AutoFilter b.Column, ListeParam2(j), xlFilterValues
ChDir "C:\Users\..."
Set xlApp = CreateObject("Excel.Application")
xlApp.SheetsInNewWorkbook = 2
Set xlBook = xlApp.Workbooks.Add
xlBook.SaveAs ("ZOOM" & ListeParam(i) & ".xls")
Set xlSheet = xlBook.Sheets(j)
xlSheet.Name = "" & j
WsSource.UsedRange.Copy xlSheet.Range("A1")
Next j
Next i
End With
End Sub |
Partager