Macro trouver solution plus simple

Résolu
Bonjour à tous !

Jaimerais avoir vos avis sur un problème :

J'ai 3 classeurs : classeur 1, 2, et 3
Dans un classeur 4, je veux recopier le contenue de tous les onglets de ces autres classeurs sur une feuil unique de mon classeur 4.
Le problème est que cette 3 autres classeurs auront un nombres indéfini d'onglets avec des noms différents que je ne connais pas (je ne peux absolument pas avoir d'emprise la dessus), il me faut donc une facon de recopier ce contenu sur ma feuille, et ce quelque soit le nombre d'onglets des classeur (qui eux auront un nom définis ).

Merci pour votre aide !!

James 405

7 réponses

  • Votes
  • Date
  • Date décroissante
  1. Modérateur
    Salut,
    Ta solution ici :
    Boucler sur tous les classeurs ouverts et dans chaque classeur boucler sur toutes les feuilles.
    Sub BouclePlagesCellules() 
        'Définit une variable qui va représenter un classeur 
        Dim Wb As Workbook 
        'Définit une variable qui va représenter une feuille de calcul 
        Dim Ws As Worksheet 
        'Définit une variable qui va représenter une cellule 
        Dim Cell As Range 
         
        'Boucle sur chaque classeur de l'application Excel 
        For Each Wb In Application.Workbooks 
            'Boucle sur chaque feuille de chaque classeur 
            For Each Ws In Wb.Worksheets 
                'Boucle sur chaque cellule de la plage A1:A10 
                For Each Cell In Ws.Range("A1:A10") 
                    'Si la cellule contient la valeur 3, on multiplie la valeur par 2 
                    'ici ça n'est qu'un exemple. Tu remplaces par .copy vers Classeur(4)... 
                    If Cell.Value = 3 Then Cell.Value = Cell.Value * 2 
                Next Cell 
            Next Ws 
        Next Wb 
    End Sub


    Cordialement,
    -- Tout problème à sa solution. S'il n'y a pas de solution, ou est le problème? --
    1. Bonjour PIjaku,

      Je viens d'essayer avec cela

      Sub mo()

      'Définit une variable qui va représenter un classeur
      Dim Wb As Workbook
      'Définit une variable qui va représenter une feuille de calcul
      Dim Ws As Worksheet

      'Boucle sur chaque classeur de l'application Excel
      For Each Wb In Application.Workbooks
      'Boucle sur chaque feuille de chaque classeur
      For Each Ws In Wb.Worksheets
      'Boucle sur chaque cellule de la plage A1:A10
      Range("A1:U400").Copy
      Windows("synthèse.xls").Activate
      Sheets("Feuil3").Select
      Range("A15").Activate
      Selection.Paste
      Next Ws
      Next Wb

      End Sub

      et cela ne fonctionne pas (je ne suis pas très fort en excel). la question que je me pose, c'est est ce qu'avec cette macro, le contenue de mes onglet (pour les cellules A1 U400) vont bien se coller les uns à la suite de l'autre sur mon onglet Feuil3??

      Merci pour ton aide,

      James
      1. Modérateur
        le contenue de mes onglet (pour les cellules A1 U400) vont bien se coller les uns à la suite de l'autre sur mon onglet Feuil3?? non. Ils vont tous se coller en A15.
        Dans ton code remplace :
        For Each Ws In Wb.Worksheets 
        'Boucle sur chaque cellule de la plage A1:A10 
        Range("A1:U400").Copy 
        Windows("synthèse.xls").Activate 
        Sheets("Feuil3").Select 
        Range("A15").Activate 
        Selection.Paste 
        Next Ws

        par :
        For Each Ws In Wb.Worksheets 
        Range("A1:U400").Copy Windows("synthèse.xls").Sheets("Feuil3").Range("A65536").End(xlUp).Offset(1, 0) 
        Next Ws
    2. d'accord je vais essayer comme ca, juste pour l'info

      End(xlUp).Offset(1, 0) a quoi servent ces deux mots ?

      Merci encore pijaku !!
      1. méthode non géré par cet objet .. J'ai bien vérifier les noms et a l'endroit mis en gras ici, il me met erreur execution 138 :

        Sub mo()
        Dim Wb As Workbook
        Dim Ws As Worksheet
        Dim cell As Range
        For Each Wb In Application.Workbooks
        For Each Ws In Wb.Worksheets
        Range("A7:U200").Copy Windows("synthèse.xls").Sheets("Feuil3").Range("A65536").End(xlUp).Offset(1, 0)
        Next Ws
        Next Wb

        End Sub

        Me serais je trompé autre part?
        1. Modérateur
          Non ça doit venir de moi. Remplacer (sans conviction) Windows par WorkBooks :
          Range("A7:U200").Copy WorkBooks("synthèse.xls").Sheets("Feuil3").Range("A65536").End(xlUp).Offset(1, 0)

          ("A65536").End(xlUp) :
          nous donne la dernière cellule non vide de la colonne A (en fait, VBA part de la dernière cellule colonne A (A65536) et remonte (xlUp) jusqu'à ce qu'il trouve une donnée).
          Offset(ligne, colonne) :
          "décale" de x ligne, x colonne...
          ActiveCell.Offset(-3, 5).Value renvoie la valeur contenue dans la cellule située 3 lignes au dessus et 5 colonnes à droite de la cellule active
          ActiveCell.Offset(1, -3).Value renvoie la valeur contenue dans la cellule située 1 ligne au dessous et 3 colonnes à gauche de la cellule active
      2. Cette fois pas d'erreur, mais ca ne fait absolument rien. calcul 1 seconde et fini la macro sans rien faire. pas de .paste manquant?
        1. Modérateur
          non pas de paste manquant. Mais si tu veux copier quelque chose, il convient de l'activer d'abord... Donc effectivement, il ne pouvait rien se passer dans ton cas. Ta macro dit :
          Pour chaque classeur ouvert
          Pour chaque feuille de ce classeur
          copie le range(gnagnagna) du classeur actif et colle le dans le classeur(synthèse)Feuille(3) etc...
          Ca ne peux pas fonctionner puisque le classeur actif est... le classeur(synthèse)... Ceci est mieux déjà :
          Sub mo() 
          Dim Wb As Workbook 
          Dim Ws As Worksheet 
          Dim cell As Range 
          For Each Wb In Application.Workbooks 
          Wb.Activate 
          For Each Ws In Wb.Worksheets 
          Ws.Activate 
          Range("A7:U200").Copy Workbooks("synthèse.xls").Sheets("Feuil3").Range("A65536").End(xlUp).Offset(1, 0) 
          Next Ws 
          Next Wb 
          End Sub
      3. HuHu ca marche !!!

        deux petites questions : - Si par la suite je protèle certaine feuille ou un copier/coller sera a faire , cela posera t il un problème?

        - Existe t il un moyen d'exclure certains onglet des classeurs??

        Merci pour tout Pijaku
        1. Modérateur
          1- oui cela posera problème... Mais tu pourras le contourner en déprotégeant...
          2- oui. Exemple : copier toutes les feuilles sauf celles nommées "Feuil2" :
          Sub mo()
          Dim Wb As Workbook
          Dim Ws As Worksheet
          Dim cell As Range
          For Each Wb In Application.Workbooks
          Wb.Activate
          For Each Ws In Wb.Worksheets
          If Ws.Name <> "Feuil2" Then
          Ws.Activate
          Range("A7:U200").Copy Workbooks("synthèse.xls").Sheets("Feuil3").Range("A65536").End(xlUp).Offset(1, 0)
          End If
          Next Ws
          Next Wb
          End Sub
        2. ok! pour le 2. ne connaissant pas le nom des onglets a l'avance, je ne pourrai pas utiliser cette méthode, par contre vu que je diffuse l'outil, peut on envisager soit de mettre un "espion" ds les feuilles qui m'interresseront pour ma synthèse, soit colorer les onglet et ne copier que ceux ci ou une autre méthode qqc?
        3. Modérateur
          tout est envisageable...
          Exemple :
          Tester le contenu d'une cellule :
          If Range("AA1").Value = "espion" Then
        4. !!!!!!!!!! J'avais pas penser à ca, je partais deja dans les codes des pages etc ....
          Je pense partir sur la coloration intérieur de la cellule A8 qui est la seule verte !!

          Sub mo()
          Dim Wb As Workbook
          Dim Ws As Worksheet
          Dim cell As Range
          For Each Wb In Application.Workbooks
          Wb.Activate
          For Each Ws In Wb.Worksheets
          If range("A8").interior.colorindex=10 then
          Ws.Activate
          Range("A7:U200").Copy Workbooks("synthèse.xls").Sheets("Feuil3").Range("A65536").End(xlUp).Offset(1, 0)
          End If
          Next Ws
          Next Wb
          End Sub

          Mais ca marche pas !!
          je pense qu'il me manque then qqch, mais je ne sais pas quoi

          En cas merci pour ton aide pijaku !!!
        5. Modérateur
          Salut,
          Hum hum... Tu n'auras donc pas retenu la leçon.
          Même erreur qu'un post précédent.
          Il faut d'abord rendre la feuille active :
          For Each Wb In Application.Workbooks  
          Wb.Activate  
          For Each Ws In Wb.Worksheets  
          Ws.Activate 
          If range("A8").interior.colorindex=10 then 
      4. Enfin je pense plus par exemple a copier uniquement les onglets qui contiennet la lettre A par exemple