Sub Création_Automatique_des_Onglets()
' Adaptée d'une macro de Charlize
' Modifée par BrunoM45
Dim Modele As Worksheet, NewSheet As Worksheet
Dim base_maquette As Worksheet
Dim newSheetName As String
Dim myRng As Range
Dim myCell As Range
Dim iCtr As Long
Dim Ref_CELLULES As Variant
Dim Test As String
' Définir les variables objet
Set Modele = Worksheets("ART.0_BASE")
Set base_maquette = Worksheets("0.Soumission")
Ref_CELLULES = Array("E8", "F8", "G8", "H8")
Application.ScreenUpdating = False
With base_maquette
Set myRng = .Range("E8", .Cells(.Rows.Count, "E").End(xlUp))
End With
For Each myCell In myRng.Cells
'With myCell
'newSheetName = Modele.Range("A1")
' Définir le nom, Copie la valeur texte de la cellule
newSheetName = "ART." & (myCell.Value)
' Tester si le classeur existe en récuperant la valeur d'une cellule
On Error Resume Next
Test = Sheets(newSheetName).Range("E8")
' Si le numéro d'erreur est différend de 0, c'est que la feuille n'existe pas
If Err.Number <> 0 Then
' On fait une copie du modèle
Modele.Copy After:=Worksheets(Worksheets.Count)
' On renomme la copie
ActiveSheet.Name = newSheetName
' On attibue les valeurs dans cette feuille
For iCtr = LBound(Ref_CELLULES) To UBound(Ref_CELLULES)
ActiveSheet.Range(Ref_CELLULES(iCtr)).Value = myCell.Offset(0, iCtr).Value
Next iCtr
End If
Next myCell
Application.ScreenUpdating = True
' Il faut peut-être penser à effacer les variables objet
Set Modele = Nothing
Set base_maquette = Nothing
Set myRng = Nothing
End Sub