modif macro recopie modele à la suite

Re : modif macro recopie modele à la suite

Salut La Vouivre,

Tu trouveras ci-joint ton fichier modifié 😉

Merci de faire des UP plutôt qu'un nouveau post
Car c'est le même sujet ICI : https://www.excel-downloads.com/threads/modif-macro-sommaire-et-creation-macro-liste-titre.99266/

attention sinon ...

A+

Re : modif macro recopie modele à la suite

Merci Bruno M45
C’est vrai j’ai refait un nouveau post, je m’en excuse.Trop pressé, le stress sans doute, même à la maison.
Je te remercie beaucoup Bruno M45.
Une dernière modif, quand je crée un onglet par la macro le modèle vierge et copier une première fois suivi par le modèle avec le titre,peut tu me supprimer le premier modèle afin qu’il n’y ait que le modèle avec le titre .
Je te repasse le fichier avec plus d’explications
Au plaisir de te lire.

Re : modif macro recopie modele à la suite

J’ai solutionné la copie en vierge du modèle, maintenant il ne reste que deux problèmes.
1 il recopie le texte de la première procédure en effaçant les autres.
2 il ne recopie pas à la suite du précédent ce qui coupe les longues procédures


Option Explicit

Sub creation_onglets()
Dim Sht As Worksheet, Cel As Range, DerLig As Long
Dim VTitre As String, NbTitre As Integer, LigTitre As Long

Application.DisplayAlerts = False
'Application.ScreenUpdating = False
With Sheets("SOMMAIRE")
DerLig = .Range("C" & Rows.Count).End(xlUp).Row
For Each Cel In .Range("B3:B" & DerLig)
' Si la cellule de la colonne B contient une valeur
If Cel.Value <> "" Then
NbTitre = 0 ' Mettre à ZERO le nombre de titre
On Error Resume Next
' Fait une copie de la feuille modèle
Sheets("MODELE").Copy After:=Sheets(Sheets.Count)
Set Sht = Sheets(Sheets.Count)
' Renomme la feuille de la valeur de la cellule
Sht.Name = Cel.Text
' Si une erreur se produit, c'est que la feuille existe déjà
' Alors on la supprime
If Err.Number <> 0 Then
Sht.Delete
Set Sht = Sheets(Cel.Value)
End If
On Error GoTo 0
End If
' Inscrire les titres ICI
VTitre = Cel.Offset(0, 1)
If VTitre <> "" Then
NbTitre = NbTitre + 1
If NbTitre = 1 Then
LigTitre = 3
Sht.Range("A3").Value = VTitre
Else
Sht.Range("A1:F41").Copy Destination:=Sht.Range("A" & (42 * (NbTitre - 1)) + 1)
LigTitre = 3 + (42 * (NbTitre - 1))
Sht.Range("A" & LigTitre).Value = VTitre
End If
' Créer le Lien Hypertexte
ActiveSheet.Hyperlinks.Add Anchor:=Cel.Offset(0, 1), Address:="", SubAddress:= _
"'" & Sht.Name & "'!A" & LigTitre, TextToDisplay:=VTitre
End If
Next Cel
End With
End Sub

Re : modif macro recopie modele à la suite

Bonjour amis Exceliens Excellienne
C’est presque bon
Apres de multiples essais, j’en suis arrivé à ce code, mais il reste un bug.
J’ai rajouté du code afin de supprimer les premières lignes vide du modèle recopié,mais le code continue d’effacer les premières lignes quand je mets un nouveau code,comment faire pour que ce code s’exécute une seule fois à la création de l’onglet .
Merci de m’aider
Bon week end à tous

Le code :

Option Explicit
Dim Sht As Worksheet

Sub creation_onglets()
Dim Cel As Range, DerLig As Long, Lig As Long
Dim VTitre As String, NbTitre As Integer, NbLigSom As Integer

Application.DisplayAlerts = False
'Application.ScreenUpdating = False

' Nombre de lignes par sommaire
NbLigSom = 10

With Sheets("SOMMAIRE")
DerLig = .Range("C" & Rows.Count).End(xlUp).Row
For Each Cel In .Range("B3:B" & DerLig)
' Si la cellule de la colonne B contient une valeur
If Cel.Value <> "" Then
NbTitre = 0 ' Mettre à ZERO le nombre de titre
On Error Resume Next
' Fait une copie de la feuille modèle
Sheets("MODELE").Copy After:=Sheets(Sheets.Count)
Set Sht = Sheets(Sheets.Count)
' Renomme la feuille de la valeur de la cellule
Sht.Name = Cel.Text
' Si une erreur se produit, c'est que la feuille existe déjà
' Alors on la supprime
If Err.Number <> 0 Then
Sht.Delete
Set Sht = Sheets(Cel.Value)
End If
On Error GoTo 0
End If
' Inscrire les titres ICI
VTitre = Cel.Offset(0, 1)
If VTitre <> "" Then
Sht.Activate
If LigFTitre(VTitre) = 0 Then
Lig = Sht.Range("C" & Rows.Count).End(xlUp).Row + 3
If Lig = 2 Then Lig = 1
Sheets("MODELE").Range("1:" & NbLigSom).Copy Destination:=Sht.Range("A" & Lig)
Sht.Range("A" & Lig + 2).Value = VTitre
' Créer le Lien Hypertexte
ActiveSheet.Hyperlinks.Add Anchor:=Cel.Offset(0, 1), Address:="", SubAddress:= _
"'" & Sht.Name & "'!A" & Lig, TextToDisplay:=VTitre
End If
End If
Next Cel
End With
'efface 4 lignes si A1;A2;A3;A4 vide
Dim intI As Integer, intArret As Integer

intI = 1
'inser le nombre de ligne à suprimer en partant du haut
intArret = 4

Do While intI < intArret
'indiquer le numéro de la colonne ou le teste dois se dérouler
If Cells(intI, 1) = 0 Then
Rows(intI).Delete
intArret = intArret - 1
Else
intI = intI + 1
End If
Loop
Rows("1:1").Select
Selection.Delete Shift:=xlUp
End Sub

Function LigFTitre(VSearch As String)
LigFTitre = 0
On Error Resume Next
LigFTitre = Cells.Find(What:=VSearch, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Row
On Error GoTo 0
End Function

Re : modif macro recopie modele à la suite

Bonsoirs amis du forum

Je galère avec le code de BrunoM45 je n’arrive pas à le maîtriser.
J’ai un problème,
Le code copie le modèle avec le titre, mais copie aussi la première fois un modèle vierge.
1 : Comment modifier ce code de l’ami BrunoM45 pour qu’il ne recopie plus une version vierge du modèle.
Je crée l’onglet en colonne B sur la feuille sommaire je met un titre en colonne C, je click sur le bouton « crée onglet et titre » si le texte de la procédure atteint 100 lignes le nouveau modèle n’est pas copier.
2 : comment a nouveau modifier le code pour qu’il accepte de longue procédure

Et ce que quelqu’un peut me donner soit le chemin pour trouver la solution ou mieux encore me solutionner les problèmes.

Merci à tous