Copier des onglets désignés

[degap05]

Bonjour,

La macro du fichier joint, copie sans code et sans bouton, la feuille active.
J'aimerais, avec votre aide, exécuter la même action simultanée sur plusieurs feuilles désignées.

Merci d'avance.
Salutations.

 

[jp14]

Re : Copier des onglets désignés

Bonjour

Ci dessous la procédure modifiée.
Copie de la feuille active avec le nom correspondant à l'onglet.

'Copier la feuille "Feuil1" vers autre classeur
Sub CopieSansCodeSansBouton()
Dim nom As String
nom = ActiveSheet.Name
'ActiveSheet.Unprotect

ActiveSheet.Copy
Application.DisplayAlerts = False
    'supprime le bouton
    On Error Resume Next
    ActiveSheet.Shapes(1).Select
    Selection.Cut
    'supprime le code
    With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
    .DeleteLines 1, .CountOfLines
    End With
    On Error GoTo 0
ActiveSheet.SaveAs ("C:\Temp\" & nom & ".xls")
'ActiveSheet.Protect
ActiveWorkbook.Close True
Application.DisplayAlerts = True
ActiveSheet.Cells(ActiveSheet.Range("A65535").End(xlUp).Row, 1).Select
'Range("A2").Activate
End Sub

A tester

JP

 

[degap05]

Re : Copier des onglets désignés

Bonjour JP14,

Merci pour ta proposition efficace.
Mon souhait, mal exprimé sans doute, aurait été d' actionner la macro une seule fois.

Je peux mettre le nom des feuilles à copier en colonne "O" de la feuille Récapitulatif (Array ?).

Merci.

 

[jp14]

Re : Copier des onglets désignés

Bonjour (re)

Si on doit toujours copier les mêmes feuilles, le nom des feuilles peuvent être dans la procédure de base.

'Copier la feuille "Feuil1" vers autre classeur
Sub copie()
CopieSansCodeSansBouton "pince"
End Sub
Private Sub CopieSansCodeSansBouton(nom As String)

'ActiveSheet.Unprotect

Sheets(nom).Copy
Application.DisplayAlerts = False
    'supprime le bouton
    On Error Resume Next
    ActiveSheet.Shapes(1).Select
    Selection.Cut
    'supprime le code
    With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
    .DeleteLines 1, .CountOfLines
    End With
    On Error GoTo 0
ActiveSheet.SaveAs ("C:\Temp\" & nom & ".xls")
'ActiveSheet.Protect
ActiveWorkbook.Close True
Application.DisplayAlerts = True
'Range("A2").Activate
End Sub

Si on ne connait pas à l'avance le nom des feuilles, on peut mettre un code dans la feuille pour indiquer que l'on doit en faire une copie.

JP

 

[degap05]

Re : Copier des onglets désignés

Bonjour (re)

Si on doit toujours copier les mêmes feuilles, le nom des feuilles peuvent être dans la procédure de base.


Si on ne connait pas à l'avance le nom des feuilles, on peut mettre un code dans la feuille pour indiquer que l'on doit en faire une copie.

JP

Ce sera toujours les mêmes feuilles. J'avais pris un exemple en feuille Récapitulatif du fichier joint.
Mais j'aimerais bien connaître également la seconde possibilité.
Merci.

 

[jp14]

Re : Copier des onglets désignés

Bonjour

Un exemple de boucle

Sub copie()
'Dim Sh As Worksheet
    For Each Sh In Worksheets
        If Sh.Range("a1") = "copie" Then
            CopieSansCodeSansBouton Sh.Name
        End If
    Next Sh
End Sub

En utilisant le code du fil précédant
JP

 

[degap05]

Re : Copier des onglets désignés

Bonjour

Un exemple de boucle

Sub copie()
'Dim Sh As Worksheet
    For Each Sh In Worksheets
        If Sh.Range("a1") = "copie" Then
            CopieSansCodeSansBouton Sh.Name
        End If
    Next Sh
End Sub

En utilisant le code du fil précédant
JP

Cette solution fonctionne parfaitement.
Dans ta proposition précédente, que je tente de faire fonctionner avec plusieurs feuilles, je bute sur le "nommage" des feuilles, est-ce:
Sub copie()
CopieSansCodeSansBouton "pince", "gaine" ou ;"gaine" ?
End Sub

 

[jp14]

Re : Copier des onglets désignés

Bonsoir

Il faut autant de ligne que de nom

CopieSansCodeSansBouton "pince"
CopieSansCodeSansBouton  "gaine"

..............................

On peut utiliser un tableau

noms= array(énumérer les feuilles)

Transmettre le tableau, puis dans la macro faire une boucle

For i = LBound(tableau) To UBound(tableau)
nom = tableau(i)

Next i

JP

 

[degap05]

Re : Copier des onglets désignés

Parfait, merci pour tes explications.
Salutations.

 

[fouadodido]

Re : Copier des onglets désignés

bonjour

Je me suis permis d'utiliser cette macro qui marche impeccable

merci au concepteur

J'avais cependant une demande

comment faire pour lorsque la macro copie l'onglet il renome le classeur en un nom qui se trouve dans une cellule définie ?

Ma selection a copier va de A1:U66 et le nom que je voudrais que le classeur s'appel est dans la cellule Z1

merci d'avance pour votre aide

cdt 🙂

 

[jp14]

Re : Copier des onglets désignés

Bonjour et bienvenue sur le forum

bonjour

comment faire pour lorsque la macro copie l'onglet il renome le classeur en un nom qui se trouve dans une cellule définie ?

Ma selection a copier va de A1:U66 et le nom que je voudrais que le classeur s'appel est dans la cellule Z1

merci d'avance pour votre aide

cdt 🙂

Il faut affecter à la variable nom une autre valeur

nom = sheets(ActiveSheet.Name).range("Z1")

L'instruction "Sheets(nom).Copy" copie la feuille entière.
Il faut donc supprimer dans la feuille crée les données en trop en rajoutant

    ActiveSheet.Rows("67:10000").ClearContents
    ActiveSheet.Columns("V:iv").ClearContents

JP

 

[fouadodido]

Re : Copier des onglets désignés

merci pour l'acceuil JP

Je suis très novice, je ne sais pas ou mettre les rajouts de code

Pourrais tu stp me l'intégrer directement dans l'ensemble de la macro si sa te gêne pas, j'aurais plus qu'a écraser celle que j'ai


merci d'avance

🙂

 

[fouadodido]

Re : Copier des onglets désignés

Merci pour ton accueil et ton aide

ça marche nickel

merci encore

Fido