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
|
Sub copySheet()
'Macro qui fait une copie du document sans les données
'Author: Kurt-Kobain
'Date: 11/01/2005
'Update: 07/03/2007
Dim sourceBook As Excel.Workbook
Dim newFile As Excel.Workbook
Dim newSheet As Worksheet
Dim indiceGraph As Integer
'Liste des noms des onglets à copier
Dim onglets(5) As String
onglets(5) = "Plouplou"
onglets(4) = "Cuicui"
onglets(3) = "Ouafouaf"
onglets(2) = "Meoooww"
onglets(1) = "Croacroa"
Set sourceBook = Application.ActiveWorkbook
Set newFile = Workbooks.Add(xlWBATWorksheet)
For i = 1 To 5
Set newSheet = newFile.Worksheets("Feuil" & i)
newSheet.Name = onglets(i)
sourceBook.Sheets(onglets(i)).UsedRange.Copy newSheet.Range("A1")
For j = 1 To sourceBook.Sheets(onglets(i)).UsedRange.Columns.Count
newSheet.Cells(j).ColumnWidth = sourceBook.Sheets(onglets(i)).Cells(j).ColumnWidth
Next
For j = 1 To sourceBook.Sheets(onglets(i)).UsedRange.Rows.Count
newSheet.Rows(j).RowHeight = sourceBook.Sheets(onglets(i)).Rows(j).RowHeight
Next
'indiceGraph = 0
'For Each Graph In sourceBook.Sheets(onglets(i)).ChartObjects
' indiceGraph = indiceGraph + 1
' Graph.CopyPicture
' newSheet.PasteSpecial Link:=False, DisplayAsIcon:=False
' newSheet.DrawingObjects(indiceGraph).Left = Graph.Left
' newSheet.DrawingObjects(indiceGraph).Top = Graph.Top
'Next Graph
newFile.Worksheets.Add Count:=1, Type:=xlWorksheet
Next
newFile.SaveAs (sourceBook.Path & "\"Lights.xls")
End Sub |
Partager