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 46 47 48
| Sub Direction222()
Dim wkb As Workbook
Dim shCounter As Integer
Dim name As String
Dim val As Range
For shCounter = 4 To ThisWorkbook.Sheets.Count ' Feuille 4 à fin
name = ThisWorkbook.Sheets(3).Range("E" & shCounter).Value ' Prend les valeurs colonne E sheet 3
ThisWorkbook.Worksheets(shCounter).Range("O1:Q28").Copy
If name <> "" Then
Set wkb = Workbooks.Add
With Range("A1:C28") 'Début de l'instruction avec : WITH
ActiveSheet.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
.Borders.Value = 1
With .Font
.Size = 12
.name = "Arial Black"
.Bold = False
.ColorIndex = 46
End With
End With
Columns("A:A").EntireColumn.AutoFit
wkb.SaveAs "F:\Partages\Commun_DRH\Taux de recouvrement\Evolution\2018\" & name & ".xls"
Sheets.Add After:=Worksheets(Worksheets.Count), Count:=9
Sheets(1).name = "31012018"
Sheets(2).name = "28022018"
Sheets(3).name = "31032018"
Sheets(4).name = "30042018"
Sheets(5).name = "31052018"
Sheets(6).name = "30062018"
Sheets(7).name = "31072018"
Sheets(8).name = "31082018"
Sheets(9).name = "30092018"
Sheets(10).name = "31102018"
Sheets(11).name = "30112018"
Sheets(12).name = "31122018"
wkb.Close savechanges:=True
''''' Else: Sheets(Count).name = Workbook("Base").Sheets(1)
'''' Workbook.Sheets(shCounter).Copy
'''' wkb
End If
Next |
Partager