Loop pour plusieurs sheets ne fonctionne pas

Résolu
bobytto Messages postés 26 Statut Membre -  
bobytto Messages postés 26 Statut Membre -
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 Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   Ambassadeur 1 588
     
    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
  2. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   Ambassadeur 1 588
     
    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
  3. bobytto Messages postés 26 Statut Membre
     
    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 Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588
       
      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
      1. bobytto Messages postés 26 Statut Membre > yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention  
          
            set p1 = fsource.Range("A6:F101").SpecialCells(xlCellTypeVisible)

        ne fonctionne pas "run time error 438, object does not support this property or method".
        0
      2. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588 > bobytto Messages postés 26 Statut Membre
         
        tu 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
  4. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   Ambassadeur 1 588
     
    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 Messages postés 26 Statut Membre
       
      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
      1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588 > bobytto Messages postés 26 Statut Membre
         
        tu peux déclarer (dim) 4 variables, et ensuite en modifier les valeurs.
        tu n'as jamais fait de programmation?
        0
      2. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588 > yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention  
          
            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
      3. bobytto Messages postés 26 Statut Membre > yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention  
         
        J'ai fait un peu de programmation mais rien de complique
        0

  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. bobytto Messages postés 26 Statut Membre
     
    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 Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588
       
      tu partages le fichier sur internet (google drive, cjoint.com, ...), et tu postes ici le lien résultant.
      0
  7. bobytto Messages postés 26 Statut Membre
     
    Compris:
    Fichier Template https://www.cjoint.com/c/JGghfiC8ZZV
    Fichier Master Template https://www.cjoint.com/c/JGghgvcLZ8V
    0
  8. bobytto Messages postés 26 Statut Membre
     
    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

Prise en compte partielle des données par la fonction filtre
identifiant-comment -
Eric2 -

14 réponses
Google Sheet : Retour à la ligne à l'intérieur d'une formule
consgab -
Yoyo01000 -

1 réponse
Faire un retour à la ligne sur Google Sheet
29vitruve -
eric -

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

6 réponses
filtre ne fonctionne plus
delphmoi -
pilas31 -

1 réponse