Voici ce j'ai obtenu ...

j'ai quelque soucis :

1 : la partie

For Each feuille In Selection.Sheets

Sub cut_paste()

Application.ScreenUpdating = False 'désactive la mise à jour de l'écran (accélère l'application)

'For Each feuille In Selection.Sheets
   ' feuille.Activate

    Cells.Select
    Selection.Copy
    Workbooks.Add
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Application.CutCopyMode = False
    ChDir "D:\Download"

'Next feuille


    ActiveWorkbook.SaveAs Filename:="D:\Download\Classeur1.xls", FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False

Application.ScreenUpdating = True 'désactive la mise à jour de l'écran (accélère l'application)

End Sub

Hello nighthawk,

Débutant ? C'est pas mal du tout !

En fait, la principale difficulté vient de la sélection multiple des feuilles.
Pour la désigner, il faut utiliser la propriété "SelectedSheets" de la fenêtre.

Ensuite, on ne peut pas continuer le travail en laissant toutes ces feuilles sélectionnées, car quand on veut copier les feuilles, Excel n'apprécie pas quand il y a une sélection multiple en cours.
Pour les désélectionner, il faut en activer une qui ne l'est pas. D'où la boucle qui les active toutes les unes après les autres. Il y a plus élégant, mais c'est moins simple.

On sort le "Workbooks.Add" de la boucle. Sinon, on créerait un nouveau classeur à chaque fois. Ce n'est sans doute pas ce que tu veux.

Pour éviter de tomber en panne de feuilles dans le nouveau classeur, on les crée dynamiquement si besoin.

Je n'ai pas testé la sauvegarde du classeur nouveau, qui me paraît correcte.

Voilà donc une proposition :

Sub cut_paste()

    Application.ScreenUpdating = False

    Dim I               As Integer  ' indice pour boucles For
    Dim F               As Integer  ' pour ajout de feuilles si besoin
    Dim Nbr             As Integer  ' nombre de feuilles à copier
    Dim NomFeuille(255) As String   ' noms stockés en table
    
    ' Stockage en table des feuilles à copier
    Nbr = 0
    For Each feuille In ThisWorkbook.Windows(1).SelectedSheets
        Nbr = Nbr + 1
        NomFeuille(Nbr) = feuille.Name
    Next
    
    ' Désactivation de la sélection multiple
    For Each feuille In Worksheets
        feuille.Activate
    Next
    
    ' Ajout nouveau classeur
    Workbooks.Add
    
    ' Boucle de copie
    F = 0
    For I = 1 To Nbr
        ThisWorkbook.Sheets(NomFeuille(I)).Cells.Copy
        F = F + 1
        If F > Worksheets.Count Then
            Sheets.Add after:=Sheets(Worksheets.Count)
        End If
        Sheets("Feuil" & F).Select
        ActiveSheet.Paste
    Next

    ' Sauvegarde du nouveau classeur
    ActiveWorkbook.SaveAs Filename:="D:\Download\Classeur1.xls", FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False

    Application.ScreenUpdating = True

End Sub

Re,

Je m'aperçois que j'ai oublié la question du collage des valeurs.
La copie de la feuille entière copiera tout, y compris les formules si tu en as. Donc, une fois que tu as fait la copie d'une feuille dans le nouveau classeur, copie-la tant que tu l'as sous la main, et fais un collage spécial des valeurs. Toutes les formules de la feuille seront remplacées par les valeurs.

A+. Ajx.

Rebonjour nighthawk,

Je ne comprends pas trop ce qui ne fonctionne pas chez toi. Je t'envoie une version légèrement modifiée. Je l'ai testée avec des générations de feuilles, des images, des formules, des mises en forme...

Les modifications que j'ai faites :

- la version précédente supposait que ta macro se trouvait dans le classeur source. Cette nouvelle version est faite pour travailler sur le classeur source. Donc, il faut ouvrir le classeur qui contient la macro, puis le classeur source, sélectionner les feuilles à extraire, et lancer la macro tout en laissant le classeur source comme classeur actif.

- j'ai rajouté le remplacement des formules par les valeurs.

Si ça ne fonctionne toujours pas, dis-moi quelle version d'Excel tu as.

Ajx.

Sub cut_paste()

    Application.ScreenUpdating = False

    Dim I               As Integer  ' indice pour boucles For
    Dim F               As Integer  ' pour ajout de feuilles si besoin
    Dim Nbr             As Integer  ' nombre de feuilles à copier
    Dim NomFeuille(255) As String   ' noms stockés en table
    Dim FicSource       As Workbook ' classeur source
    
    Set FicSource = ActiveWorkbook
    
    ' Stockage en table des feuilles à copier
    Nbr = 0
    For Each feuille In FicSource.Windows(1).SelectedSheets
        Nbr = Nbr + 1
        NomFeuille(Nbr) = feuille.Name
    Next
    
    ' Désactivation de la sélection multiple
    For Each feuille In Worksheets
        feuille.Activate
    Next
    
    ' Ajout nouveau classeur
    Workbooks.Add
    
    ' Boucle de copie
    F = 0
    For I = 1 To Nbr
        FicSource.Sheets(NomFeuille(I)).Cells.Copy
        F = F + 1
        If F > Worksheets.Count Then
            Sheets.Add after:=Sheets(Worksheets.Count)
        End If
        Sheets("Feuil" & F).Select
        ActiveSheet.Paste
        Cells.Select
        Application.CutCopyMode = False
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues
        ActiveSheet.Cells.Copy
        Cells(1, 1).Select
    Next

    ' Sauvegarde du nouveau classeur
    ActiveWorkbook.SaveAs Filename:="D:\Download\Classeur1.xls", FileFormat:= _
        xlNormal

    Application.ScreenUpdating = True

End Sub

Bonjour
je voudrais savoir plus des outils offerts par l'environnement visual basic,leurs puissances et leurs limites
Avec mes meilleurs remerciements

Hello Armojax

merci de ton aide, j'ai fais des tests, ça marche pas mal, sauf comme je t'ai dit : lorsque je dépasse 4 feuilles sélectionnées par mes soins, il m'affiche le message

Une formule ou une feuille que vous voulez déplacer contient déjà le nom ‘E’ qui existe déjà sur la feuille de destination.
Voulez vous utiliser cette version de nom ?
Pr utiliser la version du nom existante cliquez sur oui
Pr renommer la page etc…. Cliquez sur non

si non, nikel

une question, je peux récupérer le nom des feuilles du document d'origine, pour renommer les feuilles du nouveau document ?
si oui, vois tu la manière de procéder?

merci d'avance :)

Re Armojax

bon pr l'erreur bizarre: j'ai abandonné : je vois pas ce qui fait ça (il m'a retourné le cerveau), c déja trés bien :)
merci pr le nom des feuilles c bien ce qu'il fallait


Une question :

j'aimerais récupérer dans le nouveau document qui est crée que les zones d'impréssions dans les feuilles sélectionnées
(et si jamais on a pas défini des zones d'impréssions dans ces feuilles: on copie tout dans le nouveau document...)

je présume qu'on doit remplacer

ActiveSheet.Cells.Copy

Re Armojax

j'essai de chercher .. mais éveidement c faux : dc déja est ce que ceci pourrait etre une piste? ce que j'ai rajouté par rapport au code existant se trouve en italique


' Boucle de copie
F = 0
For I = 1 To Nbr

Set feuille = ActiveSheet.PageSetup
zoneimpression = feuille.PrintArea

FicSource.Sheets(NomFeuille(I).zoneimpression).Cells.Copy


F = F + 1
If F > Worksheets.Count Then
Sheets.Add after:=Sheets(Worksheets.Count)
End If
Sheets("Feuil" & F).Select
ActiveSheet.Paste
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
ActiveSheet.Cells.Copy
Cells(1, 1).Select
Next


merci de ton aide

Bonjour nighthawk,

Ta boucle For... devrait ressembler à ça :

For I = 1 To Nbr
    FicSource.Sheets(NomFeuille(I)).Cells.Copy
    F = F + 1
    If F > Worksheets.Count Then
        Sheets.Add after:=Sheets(Worksheets.Count)
    End If
    Sheets("Feuil" & F).Select
    ActiveSheet.Paste
    Cells.Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues
    With ActiveSheet
        .Cells.Copy
        .Name = NomFeuille(I)
        .PageSetup.PrintArea = FicSource.Sheets(NomFeuille(I)).PageSetup.PrintArea
    End With
Next

Le problème vient de ce qu'il des zones nommées dans
les feuilles copiées et que les noms sont identiques
elle est pas belle, la vie ?

Bonjour Armojax

ta solution marche merci (lors que je veux imprimer , il ne me "prend" que la partie défini par les zones d'impréssions ).

Mais il y a une chose que je comprends pas! :(
Normalement la mise en page est également copié, Or quand je veux imprimer le document ce n'est pas la meme disposition:

je m'explique : un exemple:
-Sur le document d'origine, la zone d'impréssion défini est un tableau.
quand je veux l'imprimer, il se met en paysage

-Sur le document copié, le meme tableau se met en portrait (ce qui fait qu'il est coupé).

on devrait pas avoir la meme mise en page?


Question 2 :
Est ce qu'il moyen de ne copier que les zones d'impréssions définis dans le document d'origine, s'il y en a pas de défini, on copie tout le document.

merci pr tes lumières :)

Bonjour NightHawk,

Dans la macro, remplace :

With ActiveSheet
    .Cells.Copy
    .Name = NomFeuille(I)
    .PageSetup.PrintArea = FicSource.Sheets(NomFeuille(I)).PageSetup.PrintArea
End With

With ActiveSheet
    .Cells.Copy
    .Name = NomFeuille(I)
End With
With ActiveSheet.PageSetup
    .PrintArea = FicSource.Sheets(NomFeuille(I)).PageSetup.PrintArea
    .Orientation = FicSource.Sheets(NomFeuille(I)).Orientation
End With

Bonjour Armojax

"Entraîne-toi à les découvrir tout seul : lance l'enregistreur de macro, et modifie les paramètres"

c'est ce que j'avais essayé de faire pour l'orrientation :)
mais sans succés :(

j'avais une erreur
"Propriété ou méthode non gérée par cet objet"
à la ligne

.Orientation = FicSource.Sheets(NomFeuille(I)).Orientation

.Orientation = FicSource.Sheets(NomFeuille(I)).PageSetup.Orientation

Bonjour

tjs pas d'idée? :)

merci

NightHawk,

Côté idées, ça va. Mais je n'ai pas passé tout mon W.E. pascal devant mon ordi...

Tu vas devoir casser quelques petites choses dans la macro, car la cible se déplace au fur et à mesure qu'on lance les fléchettes.
C'est une chose de recopier intégralement une feuille en reconduisant la zone d'impression, et c'en est une autre de ne copier que ce qui est contenu dans la zone d'impression.

Quand on recopie toute une feuille, Excel ne fait pas de détail, il reconduit tout : formats, valeurs, formules, largeur des colonnes, hauteur des lignes, images... En revanche, quand on ne copie qu'une plage de cellules – ce qui est le cas de la zone d'impression– il faut préciser certaines choses dans un collage spécial. Quant aux images, elles sont copiées ou non, selon la part de recouvrement par rapport à la plage.

Donc, récupère ta zone d'impression, et distingue 2 cas :
- Zone vide (PageSetup.PrintArea = "") : copie toute la feuille
- Zone existante : copie avec un collage spécial dans lequel tu précises ce que tu veux copier.

Restent 2 questions :
- Dans la nouvelle feuille, soit tu définis la zone d'impression au même endroit que dans la feuille source, soit tu la ramènes dans le coin supérieur gauche de la feuille
- Si tu veux copier aussi les images, soit tu les inclus intégralement dans la zone d'impression, soit tu les colle avec des instructions supplémentaires, en indiquant l'endroit où tu veux les mettre. Pour ça, tu récupères les coordonnées du coin supérieur gauche, par exemple, avec :
Sheets("Nomfeuille").ChartObjects(n°).Left (abscisse)
Sheets("Nomfeuille").ChartObjects(n°).Top (ordonnée)

Bon courage et bonne semaine.
Armojax.

Bonjour

merci pour tes conseils Armojax...

j'aurais un tite question sur la syntaxe a appliquer pour réaliser ceci :

lorsque j'ai dans mo document des colonnes cachées : ne pas les copier (ou bien les cacher automatiquement aprés les avoir copier )

je sais c'est avec cela qu'on sait que c'est caché ou pas

Worksheets("Sheet1").Columns("C").Hidden = True

...
Nbr = 0
    For Each feuille In FicSource.Windows(1).SelectedSheets
        Nbr = Nbr + 1
        NomFeuille(Nbr) = feuille.Name
    Next

    For Each feuille In Worksheets
        feuille.Activate
    Next
    
    Workbooks.Add
    
    F = 0

 For I = 1 To Nbr
        FicSource.Sheets(NomFeuille(I)).Cells.Copy
        F = F + 1

        If F > Worksheets.Count Then
            Sheets.Add after:=Sheets(Worksheets.Count)
        End If


        Sheets("Feuil" & F).Select
        ActiveSheet.Paste
        Cells.Select
        Application.CutCopyMode = False
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues

    With ActiveSheet
        .Cells.Copy
        .Name = NomFeuille(I)
    End With

    With ActiveSheet.PageSetup
        .PrintArea = FicSource.Sheets(NomFeuille(I)).PageSetup.PrintArea
        .Orientation = FicSource.Sheets(NomFeuille(I)).PageSetup.Orientation
       
    End With
    Next
...

Hello NightHawk,

Si tu utilises souvent "FicSource.Sheets(NomFeuille(I)), tu as intérêt à lui donner un alias, pour alléger :
Dim FF As Worksheet en début de procédure,
et tu places
Set FF=FicSource.Sheets(NomFeuille(I)) après chaque nouvelle valeur de I dans ta boucle.

Donc, si tu recopies toute une feuille, tu peux écrire :

For N = 1 To 256
    ActiveSheet.Columns(N).Hidden = FF.Columns(N).Hidden
Next

Bonjour, j'ai vraiment besoin d'aide !!! je dois d'éveloper visual basic, le probleme c'est que je coince la !!!
Quelle est la commende a taper pour que sur excel en tapent un numero de commanden automatiquement excel va chercher les résultat dan dotre fichier
J'espere que je me suis bien exprimer !!!!
Aider moi !!!