copier/coller feuilles dans nouveau classeur automatiquement

babouze64

XLDnaute Nouveau
bonjour à tous, et bonne année !!

petit pb :

sur une feuille excel comportant des cases à cocher nommé comme les feuilles de mon classeur. je voudrais lorsque j'appuie sur un bouton "enregistrer" qu'une macro copie les feuilles coché et qu'elle les envoie dans un nouveau classeur excel. le nom de ce classeur est celui inscrit dans une case prédéfini !!

j'ai déjà essayé mais, le code ne fonctionne partiellement que quand le nouveau classeur existe déjà, hors moi il faudrait le creer !!

pourriez vous y jeter un oeil ?

PS : bien sur c'est le résultat qui compte, et si il y a besoin de tout remanier ou simplifier, pas de soucis !!
 

Pièces jointes

  • Classeur1.xls
    43 KB · Affichages: 159
  • Classeur1.xls
    43 KB · Affichages: 162
  • Classeur1.xls
    43 KB · Affichages: 164
G

Guest

Guest
Re : copier/coller feuilles dans nouveau classeur automatiquement

Bonsoir,

Vois si cela convient:

Code:
Sub enregistrer()
    ' On vérifie qu'une case au moins est cochée
    Dim Classeur As Workbook
    
    If Range("nombrefeuilles") > 0 Then
        On Error Resume Next
        Set Classeur = Workbooks.Open(ThisWorkbook.Path & "\" & Range("nomclasseur"))
        On Error GoTo 0
        If Classeur Is Nothing Then Set Classeur = Workbooks.Add()
            
        ThisWorkbook.Activate
        If Range("youpi") = True Then Worksheets("youpi").Copy after:=Classeur.Sheets(Classeur.Sheets.Count)
        If Range("baba") = True Then Worksheets("youpi").Copy after:=Classeur.Sheets(Classeur.Sheets.Count)
        If Range("Feuil4") = True Then Worksheets("youpi").Copy after:=Classeur.Sheets(Classeur.Sheets.Count)
        'Pour enregistrer le classeur
        If Not Classeur.Saved Then
            Application.DisplayAlerts = False
            Classeur.SaveAs ThisWorkbook.Path & "\" & Range("nomclasseur") & ".xls"
            Application.DisplayAlerts = True
        End If
        Else
        MsgBox "Vous n'avez coché aucune feuille"
    End If
End Sub

A+
 

Papou-net

XLDnaute Barbatruc
Re : copier/coller feuilles dans nouveau classeur automatiquement

Bonsoir à tous,

Hasco et pierrejean m'ont doublé, mais comme je ne veux pas avoir trimé dans le vide, je t'envoie quand-même ma version :

Code:
Sub enregistrer()
    ' On vérifie qu'une case au moins est cochée
    If Range("nombrefeuilles") > 0 Then
        CeClasseur = ActiveWorkbook.Name
        NomNouvClasseur = Range("nomclasseur")
        Set NouvClasseur = Workbooks.Add
        NouvClasseur.SaveAs Filename:=ThisWorkbook.Path & "\" & NomNouvClasseur
        Workbooks(CeClasseur).Activate
          If Feuil1.Range("youpi") = True Then _
            Feuil1.Copy after:=Workbooks(2).Sheets(Workbooks(2).Sheets.Count)
          If Feuil1.Range("loulou") = True Then _
            Feuil2.Copy after:=Workbooks(2).Sheets(Workbooks(2).Sheets.Count)
          If Feuil1.Range("baba") = True Then _
            Feuil3.Copy after:=Workbooks(2).Sheets(Workbooks(2).Sheets.Count)
          If Feuil1.Range("Feuil4") = True Then _
            Feuil4.Copy after:=Workbooks(2).Sheets(Workbooks(2).Sheets.Count)
        Else
        MsgBox "Vous n'avez coché aucune feuille"
    End If
    Application.DisplayAlerts = False
    For n = 1 To 3
      Sheets("Feuil" & n).Delete
    Next
    Application.DisplayAlerts = True
End Sub

Bonne soirée à tous.
 

babouze64

XLDnaute Nouveau
Re : copier/coller feuilles dans nouveau classeur automatiquement

merci à tous, je suis toujours impressionné par la rapidité avec laquelle vous arrivez à répondre, aux problèmes données !!
(du reste j'ai déjà du mal en anglais, alors le VBA, n'en parlons pas !!)
 

babouze64

XLDnaute Nouveau
Re : copier/coller feuilles dans nouveau classeur automatiquement

Workbooks(CeClasseur).Activate
If Feuil1.Range("youpi") = True Then _
Feuil1.Copy after:=Workbooks(2).Sheets(Workbooks(2).Sheets.Count)



juste une petite question, j'essaye d'adapter le code à mon fichier final, et j'aurais aimé quelques explications sur cette partie :

("youpi") doit etre ma case nommée ainsi en fonction de la feuille correspondante à la case à cocher
Feuil1.Range ainsi que Feuil1.Copy doit faire reference à la feuille qui doit etre copier. cependant si c'est bien cela, mes feuilles ont toutes un nom et je ne sais plus qui est Feuil1 et qui est Feuil10, comment puis-je faire ?

PS: et si c'est pas ça du tout, ben on est pas dans la .......... !!
 

Papou-net

XLDnaute Barbatruc
Re : copier/coller feuilles dans nouveau classeur automatiquement

Workbooks(CeClasseur).Activate
If Feuil1.Range("youpi") = True Then _
Feuil1.Copy after:=Workbooks(2).Sheets(Workbooks(2).Sheets.Count)



juste une petite question, j'essaye d'adapter le code à mon fichier final, et j'aurais aimé quelques explications sur cette partie :

("youpi") doit etre ma case nommée ainsi en fonction de la feuille correspondante à la case à cocher
Feuil1.Range ainsi que Feuil1.Copy doit faire reference à la feuille qui doit etre copier. cependant si c'est bien cela, mes feuilles ont toutes un nom et je ne sais plus qui est Feuil1 et qui est Feuil10, comment puis-je faire ?

PS: et si c'est pas ça du tout, ben on est pas dans la .......... !!

Bonjour babouze64,

Pour info :

Feuil1 est le nom donné par défaut par Excel, il est immuable (c'est le nom qui figure à gauche dans l'explorateur de projets :

Feuil1(Feuil1)

à ne pas confondre avec le nom situé entre parenthèses, et qui lui adopte le nom indiqué par l'onglet, qui peut être modifié par instruction de l'utilisateur ou par macro.

J'utilise donc cette syntaxe, ce qui est plus sûr que de faire appel à l'index de la feuille qui change si l'on modifie la position des feuilles dans la barre d'onglets.

Espérant avoir répondu.

Cordialement.
 

babouze64

XLDnaute Nouveau
Re : copier/coller feuilles dans nouveau classeur automatiquement

tous marche à merveille................enfin je suis obligé d'enlever le code ci aprés qui fait buguer la macro !! elle se trouve normalement dans la partie Worksheet d'une feuille de mon classeur excel. comment puis-je laisser ce code sans qu'il m'intérrompe la MACRO ?

code :

Private Sub Worksheet_Calculate()
Sheets("lot four").Visible = [BD138] > 0
Sheets("lot cuisson").Visible = [BD139] > 0
Sheets("lot multifonction").Visible = [BD140] > 0
Sheets("lot distribution").Visible = [BD141] > 0
Sheets("lot laverie").Visible = [BD142] > 0
Sheets("lot CF").Visible = [BD143] > 0
Sheets("lot inox").Visible = [BD144] > 0
Sheets("lot annexe").Visible = [BD145] > 0
Sheets("lot dechet").Visible = [BD146] > 0

Sheets("MBC").Visible = [BD148] > 0
End Sub




PS : d'ailleur en passant, comment puis-je changer le code de dessus pour y assigner une cellule nomée (comme dans la macro) plutot que les coordonnée de la cellule ? car pour l'instant, si je rajoute une ligne dans ma feuille, je suis obligé de changer chaque désignation de cellule (incrémenter de 1)

merci d'avance pour votre patiente !!
 
G

Guest

Guest
Re : copier/coller feuilles dans nouveau classeur automatiquement

Bonjour,

Code:
Sub enregistrer()
         On Error Goto FinEnregistrer
         Application.EnableEvents = False
 
         '.............Suite de la macro
 
FinEnregistrer:
         Application.EnableEvents = True
End Sub

Cela devrait empêcher l'évènement Worksheet_Calculate() de se produire.

Pour la deuxième question, exemple:

Code:
Sheets("lot four").Visible = Range("[B]NomDeLaCellule[/B]") > 0

A+
 

pierrejean

XLDnaute Barbatruc
Re : copier/coller feuilles dans nouveau classeur automatiquement

Re

Dans le module contenant la sub enregistrer:
Code:
[COLOR=blue]Public flag As Boolean[/COLOR]
Sub enregistrer()
[COLOR=blue]flag = True[/COLOR]
'la macro
[COLOR=blue]flag = False[/COLOR]
End Sub

dans la feuille

Code:
Private Sub Worksheet_Calculate()
[COLOR=blue]If flag Then Exit Sub[/COLOR]
[COLOR=blue]ligne = Range(" [COLOR=red]Adresse N° ligne Origine[/COLOR]")
[/COLOR]Sheets("lot four").Visible = [COLOR=blue]Range("BD" & ligne[/COLOR]) > 0
Sheets("lot cuisson").Visible =[COLOR=blue] Range("BD" & ligne + 1)[/COLOR] > 0
Sheets("lot multifonction").Visible = [COLOR=blue]Range("BD" & ligne + 2[/COLOR]) > 0
Sheets("lot distribution").Visible =[COLOR=blue] Range("BD" & ligne + 3[/COLOR]) > 0
Sheets("lot laverie").Visible = [COLOR=blue]Range("BD" & ligne + 4)[/COLOR] > 0
Sheets("lot CF").Visible = [COLOR=blue]Range("BD" & ligne + 5)[/COLOR] > 0
Sheets("lot inox").Visible = [COLOR=blue]Range("BD" & ligne + 6[/COLOR]) > 0
Sheets("lot annexe").Visible = [COLOR=blue]Range("BD" & ligne + 7[/COLOR]) > 0
Sheets("lot dechet").Visible = [COLOR=blue]Range("BD" & ligne + 8)[/COLOR] > 0
Sheets("MBC").Visible =[COLOR=blue] Range("BD" & ligne + 10)[/COLOR] > 0
End Sub

En Rouge: A adapter

Edit: Salut Hasco :)
 

babouze64

XLDnaute Nouveau
Re : copier/coller feuilles dans nouveau classeur automatiquement

impeccable !!
vous venez de ma faire gagner de longues heures de recopiage !!

je voudrais maintenant faire la même chose avec deux autres boutons, et donc faire deux autres macros à l'identique : a savoir imprimer en PDF via pdf créator ou équivalent pour une macro et aussi imprimer physiquement sur une imprimante pour une autre macro. que dois-je changer comme code pour pouvoir faire cela ?

PS : j'imagine qu'il faut etre sur l'ordinateur en question pour pouvoir configurer le code correctement en fonction des logiciels de PDF installé ou des imprimantes disponibles, est'il possible de demander à la macro d'ouvrir l'onglet imprimer et de choisir son imprimante manuellement, cela doit surement simplifier le code, non ?

re PS : promis aprés j'arete de vous embeter !!
 

Discussions similaires