1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
| Option Explicit
Sub CreationFichiers()
Dim J As Long
Dim Nom As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Sheets("Nomenclature")
For J = 3 To .Range("G" & Rows.Count).End(xlUp).Row
Nom = .Range("G" & J)
Sheets(Array("Nomenclature", "BDD", "G3")).Copy
With ActiveWorkbook
.Sheets("G3").Range("A1") = Nom
.Sheets("G3").Name = Nom
.Sheets("Nomenclature").DrawingObjects.Delete
.SaveAs ThisWorkbook.Path & "\" & Nom
.Close
End With
Next J
End With
MsgBox "Création fichier terminée"
End Sub |
Partager