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 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84
|
Sub decoupage()
'*****************************************************************************
'**** Sélectionne le fichier à découper
'*****************************************************************************
InputFile = Application.GetOpenFilename(Filefilter:="Fichier Excel,*.xls", Title:="Sélectionner le fichier à découper")
If InputFile = False Then Exit Sub
Workbooks.OpenText Filename:= _
InputFile, Origin:=xlWindows, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=True, Comma:=False, _
Space:=False, Other:=False
Workbooks.Open Filename:=InputFile
'*****************************************************************************
'**** Recherche des informations
'*****************************************************************************
Dim mysheet1, mysheet2 As String
file = ActiveWorkbook.Name 'prend le nom du fichier actif, celui à scinder
mybook = Left(file, Len(file) - 4)
mysheet1 = Sheets("group").Name 'prend le nom de la feuille à scinder
mysheet2 = Sheets("UPC").Name 'prend le nom de la feuille à scinder
Dim i As Integer
Dim classe As String
For i = 2 To 5
classe = Sheets("Group").Cells(i, 2).Value
' Sheets("Group").Cells(i, 2).EntireRow.Copy 'Copie
ActiveWorkbook.Sheets("Group").Select
ActiveSheet.Cells(i, 2).EntireRow.Copy
'On créer l'objet Excel
Set xlsApp = CreateObject("Excel.Application")
'On défini le nombre d'onglets (ici 5)
xlsApp.SheetsInNewWorkbook = 2
'On ajoute un classeur
Set xlsBook = xlsApp.Workbooks.Add
'On donne un nom au classeur
xlsBook.SaveAs Filename:=mybook & "_" & classe
'On rend le classeur visible
xlsApp.Visible = True
'On créer l'objet onglet dans le nouveau classeur créé
Set xlsSheet = xlsBook.Worksheets(1)
'On affecte un nom aux l'onglets
xlsSheet.Name = "Group"
'on libère l'objet onglet pour pouvoir en créer un nouveau ... etc
Set xlsSheet = Nothing
Set xlsSheet = xlsBook.Worksheets(2)
xlsSheet.Name = "UPC"
Set xlsSheet = Nothing
'classe = Workbook(mybook).Sheets("Group").Cells(i, 2).Value
'Sheets("Group").Cells(i, 2).EntireRow.Copy 'Copie
'ActiveWorkbook.Sheets("Group").Select
'ActiveSheet.Cells(i, 2).Paste
ActiveWorkbook.Sheet("Group").Range("B2").Paste
'ActivateWorkbooks.Sheets("Group").Paste
Sheets("Group").Paste 'Copie
' ActiveSheet.Paste 'Collage
' ActiveWorkbook.SaveAs Filename:=mybook & "_" & classe
Next i
End Sub |
Partager