Macro copier-coller plusieurs onglets

Le 18/04/2014 à 10:03

Bonjour,

Je viens vous exposer mon problème

Voici mon code qui fonctionne très bien, je dois copier-coller mes données en valeurs dans un nouveau fichier (ici feuille_test), seulement il y'a 5 onglets et il m'en copie qu'un seul.. comment dois-je faire ?

Sub Macro9()

    Sheets("coll CRB").Select
    'A mettre dans le fichier avec le tableau
   ActiveSheet.UsedRange.Select
    'selectionne tableau
   Selection.Copy
    'copie
    Workbooks.Open Filename:="T:\RDM\...\...\Feuille_test.xls"
    'Ouvre ton classeur
   Sheets("Feuil1").Select
    'selectionne feuil3
   Range("A1").Select
    'A la cellule A1
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
   :=False, Transpose:=False
    'colle les données copier (juste les valeurs)
    Selection.PasteSpecial Paste:=xlPasteFormats
    'colle les données copier (juste les formats/couleurs)
    Selection.PasteSpecial Paste:=xlPasteColumnWidths
   'colle les données copier (juste la largeur des colonnes, ici fusion)
End Sub

Merci de m'éclairer

Bonne journée

Mel

Le 18/04/2014 à 10:41

comment dois-je faire ?

faire une boucle sur les feuilles:

sub boucle
j=6 'n° de page de la feuille de destination
for i=1 to 5 'represente tes feuilles a copier
 sheets(i).copy sheets(j).range("A1")'copie feuille i sur feuille j
next i 'prochaine feuille i
Le 18/04/2014 à 10:49

Votre réponse est bien mais je voudrais que la copie se fasse automatiquement, que je n'ai pas à rechercher un numéro de page à copier, car c'est un classeur vierge sur lequel je copie tout donc qui s'appelle "Feuil1", "Feuil2" etc...

Le 18/04/2014 à 10:57

je voudrais que la copie se fasse automatiquement

Le code du dessus etait un exemple pour la boucle sur les feuilles, remplace le "sheets(i).copy sheets(j).range("A1")"par les lignes de ton code en nommant tes feuilles par leurs numeros.

c'est un classeur vierge sur lequel je copie tout donc qui s'appelle "Feuil1", "Feuil2" etc...

le n° correspond a la place de la feuille dans le classeur, donc sheets(1) correspond a la feuille la plus a gauche dans ton classeur, sheets(2) a la deuxieme, etc...les noms des feuilles n'est pas pris en compte.

Le 18/04/2014 à 11:18

ca ne marche toujours pas ...

J'ai refais le code.

Sub Macro9()

    Sheets("i").Select 'Ici dans le code précédent j'avais mis le nom de l'onglet
    'A mettre dans le fihcier avec le tableau
   ActiveSheet.UsedRange.Select
    'selectionne tableau
   Selection.Copy
    'copie
    Workbooks.Open Filename:="T:\RDM\...\...\feuille_test.xls"
    'Ouvre ton classeur
   Sheets("Feuil1").Select
    'selectionne feuil3
   Range("A1").Select
    'A la cellule A1
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
   :=False, Transpose:=False
    'colle les données copier (juste les valeurs)
    Selection.PasteSpecial Paste:=xlPasteFormats
    'colle les données copier (juste les formats/couleurs)
    Selection.PasteSpecial Paste:=xlPasteColumnWidths
   'colle les données copier (juste la largeur des colonnes, ici fusion)

j = 1  'n° de page de la feuille de destination
For i = 1 To 5 'represente tes feuilles a copier
Sheets(i).Copy Sheets(j).Range("A1") 'copie feuille i sur feuille j
Next i 'prochaine feuille i

End Sub
Le 18/04/2014 à 11:37
Sub Macro9()
Workbooks.Open Filename:="T:\RDM\...\...\feuille_test.xls" 'Ouvre ton classeur

j = 1  'n° de page de la feuille de destination
For i = 1 To 5 'represente tes feuilles a copier
    Workbook("de depart").Sheets(i).UsedRange.Copy 'copie feuille(i) zone usedrange
    Workbook("feuille_test").Sheets(j).Range("A1").Select 'ouvre le fichier de destination
    'collages speciaux
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats
    Selection.PasteSpecial Paste:=xlPasteColumnWidths

Next i 'prochaine feuille i
End Sub

ca dois ressembler a ca, n'oublie pas de modifier "Workbook("de depart")" je ne connais pas le nom du classeur.

Le 18/04/2014 à 11:50

Je suis vraiment désolé de revenir encore, pour moi votre code parait logique mais celà ne veut pas marcher ,

Sub macro9()

est souligné en jaune et celà met en message d'erreur "Sub ou function non défini" et il va sur workbook après en erreur aussi alors que j'ai bien modifié le nom du classeur comme vous m'avez dis

Le 18/04/2014 à 12:12

j'ai zapper les "s" a workbooks et "Workbooks("feuille_test").Sheets(j).Activate " ne generera pas d'erreur contrairement a la version du dessus.

Le 18/04/2014 à 13:40

maintenant c'est ca qui est en jaune... (Ca me met : Cette opération requiert que les cellules fusionnées soient de taille identitque)

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False

Et ca copie quand même mon tableau dans le classeur vierge, mais qu'un seul onglet sur 5 (l'onglet actif en fait) donc je ne vois pas d'ou vient le problème là...

Le 18/04/2014 à 13:47

maintenant c'est ca qui est en jaune

Arf ca dois venir du fait qu'il n'y a plus de select au dessus...ajouté un range ("A1").select devrais suffire.

D'ailleurs, meme si cette macro marche, tu va coller la feuille 2 sur le collage de la feuille 1(meme destination), faut inclure un compteur de ligne pour que le collage se fasse en dessous du precedent....

Le 18/04/2014 à 13:52

Mais moi je ne veux pas coller en dessous de la feuille 1, je veux que l'onglet 1 (du classeur de données) soit collé dans la feuille 1(du classeur vierge), l'onglet 2 dans la feuille 2 et ainsi de suite...

Le 18/04/2014 à 14:09

Ah ok, j'ai due mal ajd dsl

Dans ce cas, on fait correspondre les feuilles des differents classeurs avec une seule variable(i).

comme ca feuille1 dans classeur 1 est egal a feuille 1 dans classeur 2.

Sub Macro9()
    Workbooks.Open Filename:="T:\RDM\...\...\feuille_test.xls" 'Ouvre ton classeur

    For i = 1 To 5 'represente tes feuilles a copier
       Workbook("de depart").Sheets(i).UsedRange.Copy 'copie feuille(i) zone usedrange
       Workbook("feuille_test").Sheets(i).activate 'ouvre le fichier de destination
      Range("A1").Select
       'collages speciaux
       Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
           :=False, Transpose:=False
        Selection.PasteSpecial Paste:=xlPasteFormats
        Selection.PasteSpecial Paste:=xlPasteColumnWidths

    Next i 'prochaine feuille i
    End Sub
Le 18/04/2014 à 14:31

Désolé mais ça ne marche pas non plus je desespère là ça me met encore une fois que l'indice n'appartient pas à la selection il n'y a que l'onglet actif qui marche

Le 18/04/2014 à 14:46
    Sub Macro9()
    Workbooks.Open ThisWorkbook.Path & "\Modéle.xlsm" 'Ouvre ton classeur

    For i = 1 To 5 'represente tes feuilles a copier
       Workbooks("Modéle").Sheets(i).UsedRange.Copy 'copie feuille(i) zone usedrange
       Workbooks("Feuille_test").Sheets(i).Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
           :=False, Transpose:=False
        'Selection.PasteSpecial Paste:=xlPasteFormats
        'Selection.PasteSpecial Paste:=xlPasteColumnWidths

    Next i 'prochaine feuille i
    End Sub

Donc ce code fonctionne, je l'ai testé.

Aprés tu as bien 5 feuilles dans ton fichier de "résultat"?

Le 18/04/2014 à 14:58

J'ai déjà vu ce code quelque part

Le 18/04/2014 à 15:06

Dans ce code :

Workbooks.Open ThisWorkbook.Path & "\Modéle.xlsm" 'Ouvre ton classeur

Ce n'est pas logique d'ouvrir ce classeur puisque je suis déjà dedans et c'est là que je fais ma macro..

Le 18/04/2014 à 15:14

j'ai zappé de changé le nom et le chemin du fichier que j'ouvrais pour le test.

Le 18/04/2014 à 15:48

ca ne marche pas... j'ai essayé de modifier des choses en vain..

Sub Macro1()

    Workbooks.Open "T:\RDM\...\...\Feuille_test.xls"   
    'Ouvre ton classeur

      Workbooks("2007 12 Synthèse ....xls").ActiveSheet.UsedRange.Select
      Selection.Copy
      ' Sheets(i).UsedRange.Copy 'copie feuille(i) zone usedrange
     For i = 1 To 5 'represente tes feuilles a copier
      Workbooks("Feuille_test").Sheets(i).Range ("A1")
      Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
           :=False, Transpose:=False
        Selection.PasteSpecial Paste:=xlPasteFormats
       Selection.PasteSpecial Paste:=xlPasteColumnWidths

    Next i 'prochaine feuille i

   End Sub
Le 18/04/2014 à 16:06

bonjour,

une autre proposition

Sub Macro9()
  Set twb = ThisWorkbook
  Set wb = Workbooks.Add 'creer un nouveau classeur pour recevoir les résultats
    For i = 1 To twb.Worksheets.Count - wb.Worksheets.Count 'créer des feuilles autant que nécesssaire
     wb.Worksheets.Add
    Next i
    k = 0
    For Each ws In twb.Worksheets ' copier les cellules en gardant la valeur (et non les formules)), le format et la largeur de colonne
      k = k + 1
      ws.UsedRange.Copy
      With wb.Worksheets(k).Range("A1")
       .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
       .PasteSpecial Paste:=xlPasteColumnWidths
      End With
    Next
    wb.SaveAs Filename:="T:\RDM\...\...\Feuille_test.xls" ' sauver le nouveau fichier, adapter le nom !!!!!
End Sub
Le 18/04/2014 à 16:24

Ah supeeeeeeeeeer ça marche !

Merci beaucoup h2so4

Rechercher des sujets similaires à "macro copier coller onglets"