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 49 50 51 52 53 54 55 56 57 58 59
| Sub CopieDeFeuillesChoisies()
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim CL1 As Workbook
Dim CL2 As Workbook
Dim LaFeuille As Worksheet
Dim i As Byte, ListeACopier As Variant
Dim Ok As Boolean
'On créer l'objet Excel
Set xlApp = CreateObject("Excel.Application")
'On défini le nombre d'onglets (ici 6)
xlApp.SheetsInNewWorkbook = 6
'On ajoute un classeur
Set xlBook = xlApp.Workbooks.Add
'On donne un nom au classeur
xlBook.SaveAs ("Frais de")
'On rend le classeur visible
xlApp.Visible = True
'On créer l'objet onglet dans le nouveau classeur créé
Set xlSheet = xlBook.Worksheets(1)
'On affecte un nom aux l'onglets
xlSheet.Name = "OMO"
'on libère l'objet onglet pour pouvoir en créer un nouveau ... etc
Set xlSheet = Nothing
Set xlSheet = xlBook.Worksheets(2)
xlSheet.Name = "VRDI CANAL "
Set xlSheet = Nothing
Set xlSheet = xlBook.Worksheets(3)
xlSheet.Name = "FOODS"
Set xlSheet = Nothing
Set xlSheet = xlBook.Worksheets(4)
xlSheet.Name = "HARD SOAP"
Set xlSheet = Nothing
Set xlSheet = xlBook.Worksheets(5)
xlSheet.Name = "TOILET SOAP"
Set xlSheet = Nothing
Set xlSheet = xlBook.Worksheets(6)
xlSheet.Name = "PP"
'
'
'On remet la propriété de l'application à 3 (par défaut)
xlApp.SheetsInNewWorkbook = 3
'On ferme l'application
xlApp.Quit
Set CL1 = Workbooks("Copy of Analyse des frais test")
Set CL2 = Workbooks("Frais de")
ListeACopier = Array("OMO", "VRDI CANAL ", "FOODS", "HARD SOAP", "TOILET SOAP", "PP")
For Each LaFeuille In CL1.Worksheets
For i = 0 To UBound(ListeACopier)
Ok = Ok Or LaFeuille.Name = ListeACopier(i)
Next
If Ok Then LaFeuille.Copy
Workbooks("Frais de").Worksheets(i).Range("A1").PasteSpecial Paste:=xlPasteValue, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Ok = False
Next
Set CL1 = Nothing
Set CL2 = Nothing
End Sub |
Partager