modif macro recopie modele à la suite

  • Initiateur de la discussion Initiateur de la discussion La Vouivre
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

La Vouivre

XLDnaute Occasionnel
Bonjour amis du forum
Je cherche une macro pour recopier sur une feuille un modèle a la suite d’une première copie du modèle.
Je m’explique,sur un fichier j’ai une macro qui me recopie une feuille modèle d’après une feuille sommaire ou je mets le titre,si je mets un nouveau titre la recopie, se fais normalement, mais efface tous les textes déjà présents, donc ma question ;
Quel code à modifier pour que le nouveau modèle se copie à la suite du premier
La macro recopie la première zone de texte sur la feuille de destination à la place de la feuille modèle,il faudrait quelle recopie le modèle à la suite du texte sur la feuille en sachant que le texte peut être plus ou moins longs,donc genre aller à la dernière ligne occupe et recopier du modèle

Je vous joins un fichier avec explication
 
Dernière édition:
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 ...
fessee.gif


A+
 

Pièces jointes

Dernière modification par un modérateur:
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.
 

Pièces jointes

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
 
Dernière édition:
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
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
5
Affichages
574
Retour