dupliquer la mise en forme à l'identique de la MEF

[aubelix]

Bonjour à tous les amis du Forum.

Je reviens vers vous une fois de plus pour de l'aide.
J'ai glané dans le Forum un code, que j'ai adapté à mes besoins.
Il consiste à dupliquer un modèle en autant de fois qu'il y'a de références
dans la feuille BASE. Les feuilles sont renommées aux mêmes noms
que chaque référennce. Jusque là tout se passe bien.

J'aurais souhaité lors de la duplication mettre en forme les feuilles crées
à l'identique en mise en forme que le modèle à savoir les marges, l'orientation
centrage etc...

Ou bien une macro à part qui fasse cette Mise en Forme pour toutes
les feuilles sauf celles nommées : BASE, MMODELE et REFERENCES.


Ci-dessous le code de mes duplications.

Sub creation_FICHES()
Dim SH As Worksheet
Dim cel As Range, plg As Range
Select Case MsgBox(" Voulez-vous lancer la création des FICHES " _
& vbCrLf & " (une feuille par REF)" _
, vbYesNo Or vbQuestion Or vbDefaultButton1, "Confirmation")
Case vbYes
Sheets("BASE").Range("B2").Select
Set plg = Range(Selection, Selection.End(xlDown))
Application.ScreenUpdating = False
For Each cel In plg.Cells
If cel <> "" Then
For Each SH In Worksheets
If SH.Name = cel Then GoTo suite
Next
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = cel.Value
Sheets("MODELE").Cells.Copy ActiveSheet.Cells
'Recopie les différentes rubriques spécifiées
With ActiveSheet
'Numéro identification
.Range("C12").Value = Sheets("BASE").Range("E" & cel.Row).Value
'Référence
.Range("H12").Value = Sheets("BASE").Range("B" & cel.Row).Value
'Numéro d'ordre
.Range("J4").Value = Sheets("BASE").Range("C" & cel.Row).Value

End With
End If
suite:
Next

Call MsgBox(" Toutes les FICHES ont été crées avec succes " _
& vbCrLf & " Pour accéder à la REF de votre choix" _
& vbCrLf & " Tapez : Ctrl + M" _
, vbInformation, "CTRL + M")

Case vbNo
Exit Sub
End Select
Sheets("BASE").Activate
End Sub

Par avance, Merci pour votre aide.
Cordialement.

 

[Efgé]

Re : dupliquer la mise en forme à l'identique de la MEF

Bonjour aubelix,
Comme j'ai eu la fleme de créer le fichier exemple que tu n'as pas fourni, je n'ai pas testé:

Sub creation_FICHES()
Dim SH As Worksheet
Dim cel As Range, plg As Range
Select Case MsgBox(" Voulez-vous lancer la création des FICHES " _
& vbCrLf & " (une feuille par REF)" _
, vbYesNo Or vbQuestion Or vbDefaultButton1, "Confirmation")
    Case vbYes
        Sheets("BASE").Range("B2").Select
        Set plg = Range(Selection, Selection.End(xlDown))
        Application.ScreenUpdating = False
            For Each cel In plg.Cells
                If cel <> "" Then
                    For Each SH In Worksheets
                        If SH.Name = cel Then GoTo suite
                    Next
                    Sheets("MODELE").Copy After:=Sheets(Sheets.Count)
                    Sheets(Sheets.Count).Name = cel.Value
                    'Recopie les différentes rubriques spécifiées
                        With Sheets(Sheets.Count)
                            'Numéro identification
                            .Range("C12").Value = Sheets("BASE").Range("E" & cel.Row).Value
                            'Référence
                            .Range("H12").Value = Sheets("BASE").Range("B" & cel.Row).Value
                            'Numéro d'ordre
                            .Range("J4").Value = Sheets("BASE").Range("C" & cel.Row).Value
                        End With
                End If
suite:
            Next
        Call MsgBox(" Toutes les FICHES ont été crées avec succes " _
        & vbCrLf & " Pour accéder à la REF de votre choix" _
        & vbCrLf & " Tapez : Ctrl + M" _
        , vbInformation, "CTRL + M")
    Case vbNo
        Exit Sub
End Select
Sheets("BASE").Activate
End Sub

Essai au moins d'utiliser la balise Code (#) dans tes postes
Cordialement

 

[aubelix]

Re : dupliquer la mise en forme à l'identique de la MEF

Bonjour Efgé.

Merci pour ta réponse.
Elle fonctionne parfaitement.
Que veux-tu dire par /
"Essai au moins d'utiliser la balise Code (#) dans tes postes" ?

Cordialement.

 

[Efgé]

Re : dupliquer la mise en forme à l'identique de la MEF

Re

Que veux-tu dire par /
"Essai au moins d'utiliser la balise Code (#) dans tes postes" ?

Qu'il est plus facile pour tous le monde de lire un code avec les balises (comme j'ai présenté le mien) plutot qu'un texte "en vrac".
Pour ce faire: quand tu cole ton code dans ton message, tu le selectionne et ensuite tu clique sur le bouton # qui se trouve dans les icons de l'editeur du message (troisième en partant de la droite).
Cordialement

 

[aubelix]

Re : dupliquer la mise en forme à l'identique de la MEF

Re.

Merci pour ton info.
J'y veillerai la prochaine fois.

Cordialement.

 

[aubelix]

Re : dupliquer la mise en forme à l'identique de la MEF

Re

Je saisie les références par douchette.
Malheureusement, pour une raison qui méchappe, je suis obligé de laisser
une ligne vierge entre chaque référence pour éviter que le code barre de la cellule
précédente ne se duplique sur la cellule de la ligne sur laquelle je "douche".
J'ai donc une ligne vierge entre chaque référence, que j'ai masqué...

Comment modifier le code de la création des fiches en tenant compte des
lignes vierges et masquées.
En sachant que mon début est toujours à la cellule "B2" mais de longueur
variable. Car la Macro s'arrête lorsqu'elle rencontre une ligne vide.

Par avance Merci pour votre aide.
Cordialement.

 

[Efgé]

Re : dupliquer la mise en forme à l'identique de la MEF

Re
Toujours sans exemple et donc sans test:
Supprime la ligne

Sheets("BASE").Range("B2").Select

et remplace

Set plg = Range(Selection, Selection.End(xlDown))

par

Set plg = Range("B2:B" & Range("B65536").End(xlUp).Row)

Cordialement

 

[aubelix]

Re : dupliquer la mise en forme à l'identique de la MEF

Re

Merci Efgé et à l'aveugle sans fichier exemple...
Trop lourrd pour le passer.
Un seul Mot "BRAVO"

Cordialement.