Définition de plage dans des variables

Question

J'essaye de réaliser un fichier permettant de copier des plages de données dans feuille "Bilan", ceci pour chaque feuille du fichier. Mes variables (Ch1, Ch2,...,Ch6) qui détectent la plage maximale à copier n'évoluent pas. C'est à dire que si pour la feuille 3 (qui est la première qui m'interesse) Ch1 =7, pour la feuille 4 Ch1 sera toujours égal à 7. J'ai remarqué que le problème provient probablement du SET qui "Fige" les valeurs. Cependant, ma macro ne fonctionne pas sans. Quelqu'un serait il en mesure de m'aider ? Voici mon code : Pour ceux qui consultent mon fichier il s'agit du module3 Sub Bilan_Racourci() Dim Chantier1 As Range Dim Chantier2 As Range Dim Chantier3 As Range Dim Chantier4 As Range Dim Chantier5 As Range Dim Chantier6 As Range Dim LD1, LD2, LD3, LD4, LD5, LD6 As Integer Dim Nb_Ws As Integer Dim Ch1, Ch2, Ch3, Ch4, Ch5, Ch6 As Integer Dim MultiRange As Range i = 1 LD1 = 6 LD2 = 22 LD3 = 38 LD4 = 57 LD5 = 73 LD6 = 89 Ch1 = 6 Ch2 = 22 Ch3 = 38 Ch4 = 57 Ch5 = 73 Ch6 = 89 Ligne = 1 Nb_Ws = Sheets.Count Sheets("Bilan").Activate ActiveSheet.Unprotect "Suivi" For i = 3 To Nb_Ws Do While Sheets("Bilan").Range("A" & Ligne) &lt;&gt; "" Ligne = Ligne + 1 Loop Sheets(i).Activate Do While Sheets(i).Range("C" & LD1) &lt;&gt; "" Ch1 = Ch1 + 1 LD1 = LD1 + 1 Loop Ch1 = Ch1 - 1 Set Chantier1 = Range("C6" & ":H" & Ch1) 'Chantier1.Select Do While Sheets(i).Range("C" & LD2) &lt;&gt; "" Ch2 = Ch2 + 1 LD2 = LD2 + 1 Loop Ch2 = Ch2 - 1 Set Chantier2 = Range("C22" & ":H" & Ch2) 'Chantier2.Select Do While Sheets(i).Range("C" & LD3) &lt;&gt; "" Ch3 = Ch3 + 1 LD3 = LD3 + 1 Loop Ch3 = Ch3 - 1 Set Chantier3 = Range("C38" & ":H" & Ch3) Do While Sheets(i).Range("C" & LD4) &lt;&gt; "" Ch4 = Ch4 + 1 LD4 = LD4 + 1 Loop Ch4 = Ch4 - 1 Set Chantier4 = Range("C57" & ":H" & Ch4) Do While Sheets(i).Range("C" & LD5) &lt;&gt; "" Ch5 = Ch5 + 1 LD5 = LD5 + 1 Loop Ch5 = Ch5 - 1 Set Chantier5 = Range("C73" & ":H" & Ch5) Do While Sheets(i).Range("C" & LD6) &lt;&gt; "" Ch6 = Ch6 + 1 LD6 = LD6 + 1 Loop Ch6 = Ch6 - 1 Set Chantier6 = Range("C89" & ":H" & Ch6) Set MultiRange = Union(Chantier1, Chantier2, Chantier3, Chantier4, Chantier5, Chantier6) MultiRange.Copy Sheets("Bilan").Range("A" & Ligne).PasteSpecial xlPasteValues Ch1 = 6 Ch2 = 22 Ch3 = 38 Ch4 = 57 Ch5 = 73 Ch6 = 89 Next Sheets("Bilan").Activate End Sub Cordialement, Lunta PS : Première apparition dans un forum...

ThauThème · Accepted Answer

Bonsoir Lunta et bienvenue, bonsoir le forum,

Bravo pour ta première apparition tu as bien compris le fonctionnement (fichier en pièce jointe et code entre balises). C'est tellement rare qu'il faut le souligner...

En pièce jointe ton fichier modifié avec le code ci-dessous :

Sub Bilan_Racourci()
Dim Nb_Ws As Integer 'déclare la variable Nb_Ws
Dim OA As Worksheet 'déclare la variable OA (Onglet Actif)
Dim I As Integer 'déclare la variable I (Incrément)
Dim Chantier(1 To 6) As Range 'déclare le tableau de 6 variables Chantier(1 à 6)
Dim J As Byte 'déclare la variable J (incrément)
Dim TS As ListObject 'déclare la variable TS (Tableau Structuré)
Dim R As Range 'déclare la variable R (Recherche)
Dim LI As Integer 'déclare la variable LI (LIgne)
Dim NL As Integer 'déclare la variable NL (Nombre de Lignes)
Dim K As Integer 'déclare la variable K (incrément)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Nb_Ws = Sheets.Count 'définit la variable Nb_Ws
ActiveSheet.Unprotect "Suivi" '? pourquoi
Set TS = Sheets("Bilan").ListObjects(1) 'définit le tableau structuré TS
For I = 3 To Nb_Ws 'boucle 1 : sur tous les onglets du classeurs (en partant du troisième)
    Set OA = Sheets(I) 'définit l'onglet AO
    Set Chantier(1) = OA.Range("C6:H17") 'définit le Chantier(1)
    Set Chantier(2) = OA.Range("C22:H33") 'définit le Chantier(2)
    Set Chantier(3) = OA.Range("C38:H49") 'définit le Chantier(3)
    Set Chantier(4) = OA.Range("C57:H68") 'définit le Chantier(4)
    Set Chantier(5) = OA.Range("C73:H84") 'définit le Chantier(5)
    Set Chantier(6) = OA.Range("C89:H100") 'définit le Chantier(6)
    For J = 1 To 6 'boucle 2 : sur les 6 chantiers J
        Set R = TS.ListColumns(1).Range.Find("") 'définit la recherche R (recherche du vide dans la colonne 1 de TS)
        If R Is Nothing Or TS.ListRows.Count = 0 Then 'si aucune occurrence n'est trouvée ou si TS ne contient pas encore de ligne
            TS.ListRows.Add 'ajoute une ligne à TS
            LI = TS.ListRows.Count 'définit la ligne LI (dernière ligne de TS)
        Else 'sinon (au moins une occurrence est trouvée)
            LI = R.Row - TS.HeaderRowRange.Row 'définit la ligne LI (ligne de la première occurrence trouvée moins la ligne des en-têrtes de TS)
        End If 'fin de la condition
        'renvoie dans la ligne LI les en-têtes du chantier
        TS.DataBodyRange(LI, 1).Resize(1, 5).Value = Array("Désignation", "NºFF", "Nb Moule", "Nb Pièce", "Heure décrochage")
        NL = Chantier(J).Rows.Count 'définit le nombre de lignes NL du Chantier(J)
        For K = 1 To Chantier(J).Rows.Count 'boucle 3 : sur toutes les lignes K du Chantier(J)
            If Chantier(J).Cells(K, 1).Value <> "" Then 'condition : si la première cellule de la ligne K n'est pas vide
                TS.ListRows.Add 'ajoute une ligne à TS
                LI = TS.ListRows.Count 'définit la ligne LI (dernière ligne de TS)
                'récupère dans la ligne LI de TS les valeur de la ligne K de Chantier(J)
                TS.DataBodyRange(LI, 1).Resize(1, 6).Value = Chantier(J).Rows(K).Value
            End If 'fin de la condition
        Next K 'prochaine ligne de la boucle 3
    Next J 'prochain chantier de la boucle 2
Next I 'prochaine onglet de la boucle 1
TS.ListColumns(2).Range.NumberFormat = "0"
Sheets("Bilan").Activate 'active l'onglet "Bilan"
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub

Toutefois, à tester car j'ai remarqué qu'il prenais en compte la ligne 100 du chantier 6 du premier onglet avec mon code mais pas avec le tien je pense...

Le fichier :

24lunta-ep-v01.zip (264.10 Ko)