Répétition de macro sur plusieurs feuilles d'un classeur

Question

Bonsoir, je viens de créer une petite macro pour traiter des données, seulement j'ai un petit souci! Cette macro doit être utilisé sur plusieurs feuilles "DDV1, DDV2,....DDV30"! Ces 30 feuilles ont la même structure mais je n'arrive pas à effectuer le code sans répéter la macro pour chaque feuille! Sachant qu'il y a d'autres feuilles et que seul les "DDVi" doivent être soumise à cette macro! Voici le code:

    Range("K50:K161").Value = Range("P17:P128").Value
    Range("L50:L161").Value = Range("Q17:Q128").Value
    Range("M50:M161").Value = Range("S17:S128").Value
    Range("K162:K273").Value = Range("T17:T128").Value
    Range("L162:L273").Value = Range("U17:U128").Value
    Range("M162:M273").Value = Range("W17:W128").Value
    Range("K274:K385").Value = Range("X17:X128").Value
    Range("L274:L385").Value = Range("Y17:Y128").Value
    Range("M274:M385").Value = Range("AA17:AA128").Value
    Range("K386:K497").Value = Range("AB17:AB128").Value
    Range("L386:L497").Value = Range("AC17:AC128").Value
    Range("M386:M497").Value = Range("AE17:AE128").Value
    Range("K498:K609").Value = Range("AF17:AF128").Value
    Range("L498:L609").Value = Range("AG17:AG128").Value
    Range("M498:M609").Value = Range("AI17:AI128").Value

    Range("K50:M609").Sort Key1:=Range("K50"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    
    Range("A50:B149").Sort Key1:=Range("A50"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    
    Range("D50:E409").Sort Key1:=Range("D50"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

J'ai essayé d'utilisé la fonction for each... mais rien à faire!! je bloque!! Merci d'avance pour votre aide précieuse!

cnt · Answer

Salut
voila peut etre une solution en VBA

Sub copie()
    Dim sh As Worksheet

With ActiveWorkbook
  For Each sh In Worksheets
   With sh
    .Range("K50:K161").Value = .Range("P17:P128").Value
    .Range("L50:L161").Value = .Range("Q17:Q128").Value
    .Range("M50:M161").Value = .Range("S17:S128").Value
    .Range("K162:K273").Value = .Range("T17:T128").Value
    .Range("L162:L273").Value = .Range("U17:U128").Value
    .Range("M162:M273").Value = .Range("W17:W128").Value
    .Range("K274:K385").Value = .Range("X17:X128").Value
    .Range("L274:L385").Value = .Range("Y17:Y128").Value
    .Range("M274:M385").Value = .Range("AA17:AA128").Value
    .Range("K386:K497").Value = .Range("AB17:AB128").Value
    .Range("L386:L497").Value = .Range("AC17:AC128").Value
    .Range("M386:M497").Value = .Range("AE17:AE128").Value
    .Range("K498:K609").Value = .Range("AF17:AF128").Value
    .Range("L498:L609").Value = .Range("AG17:AG128").Value
    .Range("M498:M609").Value = .Range("AI17:AI128").Value
   End With
  Next

    Range("K50:M609").Sort Key1:=Range("K50"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
   
    Range("A50:B149").Sort Key1:=Range("A50"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
   
    Range("D50:E409").Sort Key1:=Range("D50"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With
End Sub

CNTJC

likemonster · Answer

Super!!! ça marche nikel j'ai testé en vitesse et a priori ça convient.... je re-testerai demain au boulot avec le vrai fichier!! Merci beaucoup  Néanmoins je viens de me rendre conte d'un souci dans mon code:

Range("K50:M609").Sort Key1:=Range("K50"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Le classement ne s'effectue pas sachant qu'il s'agit des valeurs récupéré dans un tableau (voir code juste au dessus!). Aurais tu une idée pourquoi  ça ne marche pas?? j'ai bien les valeurs mais elles ne sont pas classé!! alors que mes 2 autres codes de classement eux fonctionnent nikel....

cs_Orohena · Answer

Salut

Tes Sort ne se font que sur la feuille active. Inclus les Sort dans les structures For Each et With, et remplace Range par .Range


Cordialement

cnt · Answer

Salut
c'est vrai que pour les tris, je ne me suis pas attardé. Orohena a bien vu cela

Sub copie()
    Dim sh As Worksheet

With ActiveWorkbook
  For Each sh In Worksheets
   With sh
    .Range("K50:K161").Value = .Range("P17:P128").Value
     ' et la suite des copies              ' '

    ' ici ce font les TRIS (ne pas oublier les "." devant "Range") 
    .Range("K50:M609").Sort Key1:=.Range("K50"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
   
    .Range("A50:B149").Sort Key1:=.Range("A50"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
   
    .Range("D50:E409").Sort Key1:=.Range("D50"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
   End With

  Next

End With
End Sub

CNTJC

likemonster · Answer

Merci beaucoup cnt et horoena, j'ai juste deux questions? une pour info, pourquoi faut il mettre un point avant range?? je ne vois pas la différence... et enfin mon dernier souci est que la macro s'effectu sur toutes les page or je ne veux qu'elle s'efffectue que sur les feuille nommé de DDV1 à DDV30? Faudrait pas faire une declaration de variable genre DDVi quelque chose de ce genre pour que juste ces feuilles soient utilisé par la macro et pas les autres!

cs_Orohena · Answer

Bonjour Je réponds à ta question sur le point. Le point introduit par cnt fait partie de la syntaxe des blocs With / End With. Il évite de répéter le nom de la variable qui suit le premier mot With. Ca veut dire que : With sh .Range("K50:K161").Value = .Range("P17:P128").Value End With est équivalent à : sh.Range("K50:K161").Value = .Range("P17:P128").Value La clause With est très parlante, elle veut dire que est au coeur des opérations qui suivent. End With, de la même manière, veut dire que ces opérations sont terminées. Un programme écrit avec de nombreux blocs With intelligemment utilisés peut être très agréable à lire et facile à déchiffrer. Pour en savoir plus, tu peux consulter l'aide en ligne du mot-clé With.

cs_Orohena · Answer

Pour la deuxième question

Effectivement tu avais précisé dès ton premier message que tu voulais que seules les feuilles DDV1 à DDV30 soient traitées. Autrement dit, il ne faut traiter une feuille DDVi que si i <=  30. Pour cela, tu dois retoucher ton code comme suit (les retouches sont en caractères gras) :

Dim i As Integer
For Each sh In WorkSheets
    With sh
         i = Val(Mid(.Name,4)) 
        If i < = 30 Then
           .Range("K50:K161").Value = .Range("P17:P128").Value
           etc, etc
        End If
    End With
Next

J'en profite pour corriger une petite erreur dans mon message précédent. Il faut lire :

est équivalent à :

   sh.Range("K50:K161").Value = sh.Range("P17:P128").Value

Amicalement

likemonster · Answer

Bonsoir Orohena! Merci infiniment pour tes réponses mais le code que tu viens d'écrire ne change rien... la macro s'exécute toujours sur toutes les pages !! Je rappel que j'ai une feuille "Paramètres", "Lancement" et le reste de "DDV1" à "DDV30"! Seul les feuilles DDVi doivent être exécutées par la macro! Est-ce possible?!

cnt · Answer

Salut
Cela devrait suffire pour accéder aux feuilles "DDVi"



Dim i As Integer, sh As Worksheet
For Each sh In Worksheets
    With sh
        If UCase(Left(.Name, 3) = "DDV") Then
           .Range("K50:K161").Value = .Range("P17:P128").Value
           etc , etc
        End If
    End With
Next



bonne chance

CNTJC

cs_Orohena · Answer

Je rappel que j'ai une feuille "Paramètres", "Lancement" et le reste de "DDV1" à "DDV30" !

Non, cette information n'apparaît nulle part dans la discussion.

Cordialement

likemonster · Answer

Effectivement, il me semblait l'avoir signalé mais non.... désolé! en tout cas le code de cnt me convient, ça correspond exactement à ce que je voulais!! Merci beaucoup à vous deux car grâce aux infos que vous m'avez donné je vais pouvoir faire de petites macros sympa qui vont me faciliter la vie. D'ailleur j'ai voulu intégrer dans la boucle le tracer d'un graphe avec le code suivant:

Dim i As Integer, sh As Worksheet
    For Each sh In Worksheets
        With sh
            If UCase(Left(.Name, 3) = "DDV") Then
            
    .Range("K50:K161").Value = .Range("P17:P128").Value
  
                                etc...
  
    .ChartObjects("Graph1").Activate
    ActiveChart.ChartArea.Select
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(1).Name = "=""DDV Exp"""
    ActiveChart.SeriesCollection(1).XValues = Range("=$K$50:$K$80")
    ActiveChart.SeriesCollection(1).Values = Range("=$L$50:$L$80")
    
    End If
    End With
    Next
    End Sub

Mais la macro bloc au niveau des codes rouge, je pensais qu'en intégrant ce code dans la boucle ça générerai un graph à chaque fois qu'on est sur une feuille DDVi! Je tiens à préciser que dans la structure des feuilles DDVi il y a déjà le graphe, je veux simplement y a ajouter les série de données!  Vs auriez une idée?

cnt · Answer

Et la leçon sur le point (.Range), elle est déja oubliée?
Aller un petit effort. La persévérence est un atout dans le but à atteindre.
Bye,bye.

CNTJC

likemonster · Answer

Complètement tu as raison, l'erreur était sous mon nez.... j'ai pas mal bossé sur mon code cet aprem je l'ai fini a 90%, il ne me reste plus qu'à rajouter une condition! En gros sur chacune des feuilles DDVi, il y a une valeur en "A2" qui n'est pas
la même sur toutes les feuilles. L'objectif de la condition est qu'elle
marque toutes les valeurs de la colonne D de la feuille "Lancer
simulation" sur la feuille DDVi en "A5"si elles sont inférieur à "A2". Voici mon
code, je pense que j'ai un problème pour déclarer la case "A2" des
feuilles DDVi. 

Dim i As Integer, sh As Worksheet

Dim DerniereLigne As Long                         'dans la feuille à écrire "DDVi"

Dim LigneActive As Long                            'dans la feuille à lire "Lancer simulation"

    For Each sh In Worksheets

        With sh

            If UCase(Left(.Name, 3) = "DDV") Then

            Sheets("Lancer simulation").Select

Range("D5").Select

While ActiveCell.Value <> Empty

LigneActive = ActiveCell.Row                            'n° de la ligne "à lire"

If Cells(LigneActive, 4).Value <= .Range("A2") Then

DerniereLigne = .Range("A65536").End(xlUp).Offset(1, 0).Row                     'n° de la ligne "à écrire"

.Cells(DerniereLigne, 1).Value = Cells(LigneActive, 4).    Value                       'écrit dans la 1ère colonne la valeur trouvée dans la colonne D

Wend

   ........ suite du code........

Je suis presque au bout, il ne me reeste que cette grosse condition et quelques petit arrangement..... mais la ça veux pas!!

cnt · Answer

Si j'ai bien compris ta démarche, voila une solution:

Dim i As Integer, sh As Worksheet
Dim DerniereLigne As Long                         'dans la feuille à écrire "DDVi"
Dim LigneActive As Long                            'dans la feuille à lire "Lancer simulation"
For Each sh In Worksheets

  With sh
    If UCase(Left(.Name, 3) = "DDV") Then

        Sheets("Lancer simulation").Select
        Range("D5").Select
        While ActiveCell.Value <> Empty
            LigneActive = ActiveCell.Row                      'n° de la ligne "à lire"
            If Cells(LigneActive, 4).Value <= .Range("A2").Value Then
                'n° de la ligne "à écrire"
                DerniereLigne = .Range("A65536").End(xlUp).Offset(1, 0).Row
                
                'écrit dans la 1èreligne(non pas colonne) la valeur trouvée dans la colonne D
                .Cells(DerniereLigne, 1).Value = Cells(LigneActive, 4).Value
            End If
            'nouvelle cellule active D5,D6,etc...
            Range(ActiveCell.Offset(1, 0).Address).Select
        Wend
    End If
  End With

Nextsh

Si ce n'est pas ça, décrit plus mieux la procédure

CNTJC

Répétition de macro sur plusieurs feuilles d'un classeur

14 réponses

Votre réponse

Discussions similaires