XL 2016 macro erreur exécution 1004

[Laurence2626]

Bonjour à tous

J'ai un tableau de référence et un modèle.
Je cherche à créer autant d'onglets avec ce modèle qu'il y a de ligne dans le tableau.
J'ai trouvé le code ici mais même si la macro fonctionne j'ai un message d'erreur que je ne comprends pas erreur d’exécution 1004
De plus la macro créer des onglets me crée deux onglets en trop
Pour plus de précisions je vous joint le fichier épuré

Merci a celui ou celle qui aura la gentillesse de m'aider

Laurence

 

[sylvanu]

Bonjour Laurence,
Le problème vient de vos cellules fusionnées en lignes 29,30,31. ( les cellules fusionnées créent toujours des problèmes. A éviter )

Votre Range("A" & Rows.Count).End(xlUp).Row vaut 31 car les 3 cellules fusionnées sont référencées en A.
Il créé ses feuilles et arrivé à la ligne 28 il boggue car A28 est vide donc impossible de renommer la feuille créée.

Deux solutions :
Faire : Range("B" & Rows.Count).End(xlUp).Row qui lui s’arrête à 27 ( si cela vous convient )
ou Range("A" & Rows.Count).End(xlUp).Row-4 pour qu'il s’arrête à 27. Mais cela suppose que jamais vous ne rajouterez de ligne entre la fin du tableau et total général.

 

[Laurence2626]

Merci Sylvanu

je teste votre solution. Oui cela me convient si cela s’arrête à 27
au maximum j'ai toujours l'option de rajouter des lignes

 

[Laurence2626]

Magnifique
encore merci

 

[fanch55]

Bonjour Laurence,
Vous ne renseignez pas le Dico alors que vous y faites référence dans votre Sub :
Personnellement, j'aurai transformé la liste en tableau ... mais ci-dessous le code initial modifié :

Sub CrééerLesFiches()

Application.ScreenUpdating = False
Set fb = ActiveSheet
Set fm = Sheets("Modèle")
Set dico = CreateObject("Scripting.Dictionary")
For Each f In Worksheets
dico(f.Name) = ""
Next f
dico(vbNullString) = vbNullString

Sheets("Modèle").Visible = True
For ln = 8 To fb.Range("A" & Rows.Count).End(xlUp).Row
nom = fb.Range("B" & ln)

If Not dico.exists(nom) Then
Sheets("Modèle").Copy after:=Sheets("TABLEAU DE REPARTITION")
ActiveSheet.Name = nom
Range("E3") = fb.Range("B" & ln)
Range("E4") = fb.Range("C" & ln)
Range("E5") = fb.Range("D" & ln)

For i = 1 To 8
'ln = Choose(i, 12, 13, 14, 15, 16, 17, 18, 19)
lgn = Choose(i, 13, 13, 33, 33, 53, 53, 73, 73)
col = Choose(i, 3, 9, 3, 9, 3, 9, 3, 9)
Cells(lgn, col).Value = fb.Cells(ln, i + 11).Value
Next i
dico(nom) = nom
End If
Next ln
Sheets("Modèle").Visible = True
End Sub

 

[Laurence2626]

Merci fanch55