Loop pour plusieurs sheets ne fonctionne pas [Résolu]

Signaler
Messages postés
26
Date d'inscription
mardi 10 janvier 2017
Statut
Membre
Dernière intervention
6 juillet 2020
-
Messages postés
26
Date d'inscription
mardi 10 janvier 2017
Statut
Membre
Dernière intervention
6 juillet 2020
-
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

Messages postés
11779
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
9 août 2020
674
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
Messages postés
11779
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
9 août 2020
674
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
Messages postés
26
Date d'inscription
mardi 10 janvier 2017
Statut
Membre
Dernière intervention
6 juillet 2020

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
Messages postés
11779
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
9 août 2020
674
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
Messages postés
26
Date d'inscription
mardi 10 janvier 2017
Statut
Membre
Dernière intervention
6 juillet 2020
>
Messages postés
11779
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
9 août 2020

    set p1 = fsource.Range("A6:F101").SpecialCells(xlCellTypeVisible)

ne fonctionne pas "run time error 438, object does not support this property or method".
Messages postés
11779
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
9 août 2020
674 >
Messages postés
26
Date d'inscription
mardi 10 janvier 2017
Statut
Membre
Dernière intervention
6 juillet 2020

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)
Messages postés
11779
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
9 août 2020
674
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?
Messages postés
26
Date d'inscription
mardi 10 janvier 2017
Statut
Membre
Dernière intervention
6 juillet 2020

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.
Messages postés
11779
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
9 août 2020
674 >
Messages postés
26
Date d'inscription
mardi 10 janvier 2017
Statut
Membre
Dernière intervention
6 juillet 2020

tu peux déclarer (dim) 4 variables, et ensuite en modifier les valeurs.
tu n'as jamais fait de programmation?
Messages postés
11779
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
9 août 2020
674 >
Messages postés
11779
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
9 août 2020

    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
Messages postés
26
Date d'inscription
mardi 10 janvier 2017
Statut
Membre
Dernière intervention
6 juillet 2020
>
Messages postés
11779
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
9 août 2020

J'ai fait un peu de programmation mais rien de complique
Messages postés
26
Date d'inscription
mardi 10 janvier 2017
Statut
Membre
Dernière intervention
6 juillet 2020

Ok je vais partager mes fichiers avec la macro en enlever les donnees sensibles cela sera plus simple.
comment faire pour inserer des fichiers?
Messages postés
11779
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
9 août 2020
674
tu partages le fichier sur internet (google drive, cjoint.com, ...), et tu postes ici le lien résultant.
Messages postés
26
Date d'inscription
mardi 10 janvier 2017
Statut
Membre
Dernière intervention
6 juillet 2020

Compris:
Fichier Template https://www.cjoint.com/c/JGghfiC8ZZV
Fichier Master Template https://www.cjoint.com/c/JGghgvcLZ8V
Messages postés
26
Date d'inscription
mardi 10 janvier 2017
Statut
Membre
Dernière intervention
6 juillet 2020

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!