Loop pour plusieurs sheets ne fonctionne pas

Résolu
bobytto -  
Bonjour,
Apres avoir regarde plusieurs forum sans trouver de solution a mon probleme je pose ma question ici.
Je pense que c'est plutot simple mais le code ne fait pas la chose desiree.
En gros j'aimerais faire une loop sur plusieurs sheet du meme fichier (pas sur toutes les sheets).
J'ai un fichier nomme Master et un autre Template.
Le but etant de copier les donnees de Template dans Master (j'etire aussi une formule en colonne H).
Bref quand je run la macro elle fonctionne uniquement pour la sheet active dans Template mais pas pour les autres.
Code ci-dessous: 

Sub Macro2()

    Dim mst As Worksheet: Set mst = Workbooks("Master").Sheets("Data")
    Dim tp As Workbook: Set tp = Workbooks("Template") 
    Dim p1 As Range:          Set p1 = Range("A6:F101")
    Dim p2 As Range:          Set p2 = Range("A6:E101,G6:G101")
    Dim p3 As Range:          Set p3 = Range("A6:E101,H6:H101")
    Dim p4 As Range:          Set p4 = Range("A6:E101,J6:J101")
    
For Each Worksheet In tp.Worksheets

    
p1.SpecialCells(xlCellTypeVisible).Copy
mst.Activate
Range("B1048576").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Range("H1048576").End(xlUp).Offset(1, 0).Select
ActiveCell.FormulaR1C1 = "1"
ActiveCell.AutoFill Range(ActiveCell, ActiveCell.Offset(0, -2).End(xlDown).Offset(0, 2)), Type:=xlFillCopy

p2.SpecialCells(xlCellTypeVisible).Copy
mst.Activate
Range("B1048576").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Range("H1048576").End(xlUp).Offset(1, 0).Select
ActiveCell.FormulaR1C1 = "2"
ActiveCell.AutoFill Range(ActiveCell, ActiveCell.Offset(0, -2).End(xlDown).Offset(0, 2)), Type:=xlFillCopy

'p3 [..meme code qu'au dessus..] 
'p4 [..meme code qu'au dessus..] 

Next

End Sub


Voici pour le code.
Autre subtilite, je suis oblige de cacher les sheets pour les quelles je ne veux pas que la macro fonctionne puis je les decache une fois la macro finie.
Une idee de comment faire une loop sur certaines sheets d'un fichier?

Merci pour votre aide,

Ben

7 réponses

  1.  yg_be Contributeur Ambassadeur
    je propose de commencer ainsi: 
    Option Explicit
Sub Macro2()

Dim mst As Worksheet, tp As Workbook, ws As Worksheet
Dim p1 As Range, p2 As Range, p3 As Range, p4 As Range

Set mst = Workbooks("Master.xlsx").Sheets("Data")
Set tp = ThisWorkbook
    
For Each ws In tp.Worksheets
    Select Case ws.Name
        Case "BW", "REF.", "Check", "PT_ad_hoc"
        Case Else
            Set p1 = ws.Range("A6:F101")
            Set p2 = ws.Range("A6:E101,G6:G101")
            Set p3 = ws.Range("A6:E101,H6:H101")
            Set p4 = ws.Range("A6:E101,J6:J101")
            p1.SpecialCells(xlCellTypeVisible).Copy
            mst.Activate
            Range("B1048576").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
            Range("H1048576").End(xlUp).Offset(1, 0).Select
            ActiveCell.FormulaR1C1 = "1"
            ActiveCell.AutoFill Range(ActiveCell, ActiveCell.Offset(0, -2).End(xlDown).Offset(0, 2)), Type:=xlFillCopy
            
            p2.SpecialCells(xlCellTypeVisible).Copy
            mst.Activate
            Range("B1048576").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
            Range("H1048576").End(xlUp).Offset(1, 0).Select
            ActiveCell.FormulaR1C1 = "2"
            ActiveCell.AutoFill Range(ActiveCell, ActiveCell.Offset(0, -2).End(xlDown).Offset(0, 2)), Type:=xlFillCopy
            
            p3.SpecialCells(xlCellTypeVisible).Copy
            mst.Activate
            Range("B1048576").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
            Range("H1048576").End(xlUp).Offset(1, 0).Select
            ActiveCell.FormulaR1C1 = "3"
            ActiveCell.AutoFill Range(ActiveCell, ActiveCell.Offset(0, -2).End(xlDown).Offset(0, 2)), Type:=xlFillCopy
            
            p4.SpecialCells(xlCellTypeVisible).Copy
            mst.Activate
            Range("B1048576").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
            Range("H1048576").End(xlUp).Offset(1, 0).Select
            ActiveCell.FormulaR1C1 = "4"
            ActiveCell.AutoFill Range(ActiveCell, ActiveCell.Offset(0, -2).End(xlDown).Offset(0, 2)), Type:=xlFillCopy
    End Select
Next ws

End Sub
    1
    1. yg_be Contributeur Ambassadeur
      bonjour,
      1) merci d'utiliser les balises de code (en utilisant basic pour le VBA): https://codes-sources.commentcamarche.net/faq/11288-les-balises-de-code
      2) il est recommandé d'éviter les select et activate
      3) il est recommandé de toujours qualifier avec quelle feuille on travaille, donc ne jamais écrire range mais plutôt, par exemple, mst.range
      4) il est rarement nécessaire d'utiliser copy/paste, il suffit souvent de faire ainsi: 
      dim rsource as range, rdest as range
' ...
rdest=rsource

      5) exemple de boucle: 
      dim fsource as worksheet
For Each fsource In tp.Worksheets
    ' ...
next fsource
      0
      1. bobytto Auteur
        bonjour,
        merci pour votre retour.

        1) Ok je note

        2) je remplace donc 
        mst.Activate
Range("B1048576").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Range("H1048576").End(xlUp).Offset(1, 0).Select


        par 

        mst.Range("B1048576").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
mst.Range("H1048576").End(xlUp).Offset(1, 0).Select


        3) en effet je suis d'accord. Mon cas present est que jai 9 feuilles du coup je devrais dupliquer mes p1/p2/p3/p4 en neuf fois en specifiant la range dans mon Dim de depart. Cela me semble rebarbatif et confusant c'est pour cela que j'ai essaye de definir une range qui sera la meme dans mes 9 feuilles. Je pense que le probleme vient de la.

        4) je ne comprends pas bien comment utiliser cela.

        5) Ok je note

        Merci pour votr eaide,
        Ben
        0
        1. yg_be Contributeur Ambassadeur
          pour le point 3, ne suffit-il pas de faire, dans la boucle, 
          set p1 = fsource.Range("A6:F101").SpecialCells(xlCellTypeVisible)
          ?
          pour le point 4, par exemple 
          mst.Range("H1048576").End(xlUp).Offset(1, 0).resize(p1.rows.count,p1.columns.count)=p1
          0
        2. bobytto Auteur
          @yg_be
              set p1 = fsource.Range("A6:F101").SpecialCells(xlCellTypeVisible)

          ne fonctionne pas "run time error 438, object does not support this property or method".
          0
        3. yg_be Contributeur Ambassadeur
          @bobyttotu ne montres qu'un bout de code, l'erreur peut être ailleurs.
          peut-être simplement 
          set p1 = fsource.Range("A6:F101")
          , et ensuite utiliser 
          p1.SpecialCells(xlCellTypeVisible)
          0
      2. yg_be Contributeur Ambassadeur
        comment faire une loop sur certaines sheets d'un fichier: le point de départ est de décider comment déterminer de quelles sheets il s'agit. sur base d'une liste de noms à inclure ou à exclure? si c'est une liste de noms à inclure, il suffit de boucler sur la liste de noms, non?
        0
        1. bobytto Auteur
          oui je suis d'accord, cependant si je dois determiner de quelles sheets il s'agit je devrait faire definir mes 4 dim de depart x 9 car j'ai 9 sheets.
          Cela fait bcp de lignes et j'aimerais faire cela de maniere dynamique, d'ou la loop avec les range predefini dans mes dim de depart.
          0
        2. yg_be Contributeur Ambassadeur
          @bobyttotu peux déclarer (dim) 4 variables, et ensuite en modifier les valeurs.
          tu n'as jamais fait de programmation?
          0
        3. yg_be Contributeur Ambassadeur
          @yg_be
              Dim mst As Worksheet, tp As Workbook,  fsource as worksheet
    Dim p1 As Range,  p2 As Range,  p3 As Range, p4 As Range
Set mst = Workbooks("Master").Sheets("Data") 
Set tp = Workbooks("Template")   
For Each fsource In tp.Worksheets    
            Set p1 = fsource.Range("A6:F101")
          Set p2 = fsource.Range("A6:E101,G6:G101")
          Set p3 = fsource.Range("A6:E101,H6:H101")
          Set p4 = fsource.Range("A6:E101,J6:J101")
           '...
next fsource
          0
        4. bobytto Auteur
          @yg_beJ'ai fait un peu de programmation mais rien de complique
          0
      4. bobytto Auteur
        Ok je vais partager mes fichiers avec la macro en enlever les donnees sensibles cela sera plus simple.
        comment faire pour inserer des fichiers?
        0
        1. yg_be Contributeur Ambassadeur
          tu partages le fichier sur internet (google drive, cjoint.com, ...), et tu postes ici le lien résultant.
          0
      5. bobytto Auteur
        Compris:
        Fichier Template https://www.cjoint.com/c/JGghfiC8ZZV
        Fichier Master Template https://www.cjoint.com/c/JGghgvcLZ8V
        0
        1. bobytto Auteur
          Ca marche !
          Je pense que le probleme venait de la declaration de mon "tp" puis des ranges qui vont avec.
          Super la technique du "select case" je ne connaissais pas.
          Je vais garder ton code tel quel et essayer de changer les select/copy/paste plus tard (j'ai une deadline pour cette semaine).
          Merci beaucoup!
          0

          Discussions similaires

          Google Sheet : Retour à la ligne à l'intérieur d'une formule
          consgab

          1 réponse
          Prise en compte partielle des données par la fonction filtre
          identifiant-comment

          14 réponses
          Faire un retour à la ligne sur Google Sheet
          29vitruve

          7 réponses
          Retour à la ligne google sheets android
          arthour22500

          6 réponses
          filtre ne fonctionne plus
          delphmoi

          1 réponse