Correction pour création automatique d'onglet

[mawua]

Bonjour tout le monde,
J'ai créé une macro sur bouton chargée de créer des onglets en fonction d'un tableau.
Ce que fait la macro dans l'ordre, en fin j'espère parce qu'elle ne fonctionne pas:

1- Selection de la dernière ligne non vide du tableau, dans la colonne C.
2- A partir de la cellule ainsi selectionnée, recherche de la dernière cellule non vide vers la droite, la j'ai un peu improvisé, j'ai tenté de concatener des formule que j'ai trouvé sur le forum.
3- pour chacune de ces cellules (parmi celles selectioné de 1- à 2-), il faut creer un onglet selon le modele ("Certificat") dont le nom est son entete de colone (Ligne 3).

Voici le code
Private Sub CommandButton1_Click()
Dim rngCell As Range
Dim Lig As Integer

For n = 4 To 28 Step 1
If Range("C" & n).Value = "" Then
Lig = n - 1
Exit For
End If
Next n

Application.ScreenUpdating = False
For Each rngCell In Range("C" & Lig & ":" & Range("IV" & Lig).End(xlToLeft).Address(0, 0)).Select
On Error GoTo Fin
Sheets("Certificat pour paiement").Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = rngCell.Offset(3-Lig, 0).Value
Application.ScreenUpdating = True
Next rngCell
Fin:
End Sub

S'il faut un exemple n'hésitez pas à demander.
Merci pour vos propositions.

 

[mawua]

Re : Correction pour création automatique d'onglet

En fait je repond tout seul à ma question.
Le problème venait du fait qu'il fallait que je déclare une plage de cellule supplémentaire, afin de faciliter la recherche dans cette plage.
Ainsi, j'ai sortis:
Range("C" & Lig & ":" & Range("IV" & Lig).End(xlToLeft).Address(0, 0)).Select

et l'ai collé dans une variable range
Set PlgCell = Range("C" & Lig & ":" & Range("IV" & Lig).End(xlToLeft).Address(0, 0))
Puis j'effectue la recherche
For Each rngCell in PlgCell

Voili, si jamais ça peut servir à quelqun.

 

[Gorfael]

Re : Correction pour création automatique d'onglet

Salut mawua et le forum

Private Sub CommandButton1_Click()
Dim rngCell As Range
Dim Lig As Integer

Application.ScreenUpdating = False

Lig = range("C28").end(xlup).row
If Lig < 4 then Lig = 4

For Each rngCell In Range("C" & Lig & ":" & Range("IV" & Lig).End(xlToLeft).address)
On Error GoTo Fin
Sheets("Certificat pour paiement").Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = rngCell.Offset(3-Lig, 0).Value

Next rngCell
Fin:
Application.ScreenUpdating = True
End Sub
Le même avec quelques modifs :
Ta recherche pour la dernière cellule ce C en partant de ligne 28
ton erreur ligne For Each vient juste du fait que tu la sélectionnes en la déclarant en zone de recherche
si tu utilises screenupdating, autant lui donner la plus longue portée
Pourquoi déclarer une étiquette ( Fin: ) si tu ne t'en sers pas ?
A+