Mettre en place une boucle sur une macro existante

Bonjour à tous,

j'utilise une macro que Arturo83 m'avait généreusement fournit par le passé pour récolter des valeurs sur plusieurs feuilles et me les afficher sur une grille que voici :

Sub Resultat()
    Dim i As Long, j As Long, Lig_Dest As Long, Col_Dest As Long
    Dim Seuil_Bas As Long, Seuil_Haut As Long, Maxi As Long, Mini As Long
    Application.ScreenUpdating = False
    Sh_Res.Range("C7:AU28").ClearContents 'effacement des précédents résultats
    Seuil_Haut = Sh_Res.Range("B1").Value
    Seuil_Bas = Sh_Res.Range("B2").Value
    Maxi = Sh_Res.Range("B3").Value
    Mini = Sh_Res.Range("B4").Value
    Lig_Dest = 7 'première ligne de la feuille "Resultat" ou sera recopiée les valeurs
    For i = 9 To Sheets.Count
        Col_Dest = 3 'première colonne de la feuille "Resultat" ou sera recopiée les valeurs
           'Application des formules pour trouver les valeurs à exporter vers la feuille "Resultat"
            Sheets(i).Range("DD55:EV55").FormulaR1C1 = "=R[-3]C[-105]"
            Sheets(i).Range("DD57:EV57").FormulaR1C1 = "=COUNTIF(R[-55]C:R[-5]C,MAX(R[-55]C:R[-5]C))"
            Sheets(i).Range("DD52:EV52").FormulaR1C1 = "=Sum(R[0]C[-48]:R[-50]C[-48])"
            'Exportation des valeurs comprises dans les seuils
            For j = 108 To 152 'de la colonne 19 à 49
                If Sheets(i).Cells(57, j) >= Seuil_Bas And Sheets(i).Cells(57, j) <= Seuil_Haut And Sheets(i).Cells(52, j) >= Mini And Sheets(i).Cells(52, j) <= Maxi Then
                    Sh_Res.Cells(Lig_Dest, Col_Dest).Value = Sheets(i).Cells(55, j).Value
                    Col_Dest = Col_Dest + 1 'colonne suivante de la feuille "Resultat" ou sera recopiée les valeurs
                End If
            Next j
        Sh_Res.Cells(Lig_Dest, "B").Value = Sheets(i).Name 'copie le nom de la feuille traitée en colonne B
        Lig_Dest = Lig_Dest + 1 'ligne suivante de la feuille "Resultat" ou sera recopiée les valeurs
    Next i
End Sub

Puis je renseigne sur ma feuille en B1, B2, B3, B4 les paramètres pour la récolte de valeurs..

Ensuite à l'aide d'une autre macro fournit également par Arturo83, je classe les valeurs récoltés en ligne et m'affiche aussi les valeurs inexistant de la récolte que voici :

Sub EnLigne()
    Dim DerLig As Long, DerCol As Long, i As Long, Col_Dest_Exist As Long, Col_Dest_NonExist As Long
    Dim NbExist As Long, NbNonExist As Long
    Application.ScreenUpdating = False
    Rows("32:34").ClearContents 'Effacement des précédents résultats
    Col_Dest_Exist = 3 'première colonne libre pour résultat des valeurs existantes
    Col_Dest_NonExist = 3 'première colonne libre pour résultat des valeurs inexistantes
    DerLig = Range("B" & Rows.Count).End(xlUp).Row 'Dernière ligne de la liste
    DerCol = Range(Cells(7, "C"), Cells(DerLig, 100)).SpecialCells(xlCellTypeLastCell).Column 'Dernière colonne de la liste
    For i = 1 To 40 'pour le numéros de 1 à 40
        NbExist = Application.WorksheetFunction.CountIf(Range(Cells(7, "C"), Cells(DerLig, DerCol)), i) 'on compte le nombre de fois ou l'on trouve le numéro recherché
        If NbExist = 0 Then 'si le nombre de fois est égal à 0, alors:
            Cells(34, Col_Dest_NonExist).Value = i 'on l'inscrit sur la ligne 34
            Col_Dest_NonExist = Col_Dest_NonExist + 1 'on incrémente de 1 la nouvelle colonne de destination
        Else 'sinon:
            Range(Cells(32, Col_Dest_Exist), Cells(32, Col_Dest_Exist + NbExist - 1)).Value = i 'on recopie le numéro trouvé autant de fois qu'il existe
            Col_Dest_Exist = Col_Dest_Exist + NbExist 'on incrémente le numéro de la dernière colonne du nombre de fois où le numéro à été trouvé
        End If
    Next i 'on cherche le numéro suivant
End Sub

Jusque là tout fonctionne à merveille, sauf que avec le temps je dois effectuer de plus en plus de calcul en renseignant à chaque fois en B1, B2 de la macro RESULTAT des valeurs différents pour ensuite les copier coller sur une autre feuille ou je les classes et cela devient redondant d’où mon idée de pouvoir renseigner une "plage de valeurs" en B1 et B2 ou il pourrait y avoir une boucle et me les afficher à la suite avec un saut de 8 lignes par résultat et par la même occasion me calculer les résultats de la macro ENLIGNE sur cette même boucle.

Donc pour résumer l'objectif est de fusionner les 2 macros et faire en sorte que en B1 et B2 soient bouclés en gardant les paramètres de B3 et B4 pour qu'au lieu de faire exemple, si je renseigne B1=20 et B2=1 de (B2 à B1) le résultat sera 1 à 20, 2, 20, 3,20 jusqu'à 20 20 sur une grille, puisse me faire B1=20 B2=1, résultat sera 1 1, 2 2, 3 3, 4,4 jusqu'à 20 20 sur plusieurs grilles en gardant les paramètres de B3 et B4 avec un saut de 8 lignes par résultat (1 1 saut 8 ligne, 2 2 saut 8 ligne, etc..) et inclure le classement ENLIGNE.

Pour avoir encore une meilleure clarté de ma demande j'ai illustré sur une démo le processus de fonctionnement que j'aimerais faire. (La démo n'est pas fonctionnelle, c'est juste visuel pour la compréhension du processus)

12demo-1.xlsm (34.88 Ko)

Au vu de la complexité de la modification à effectuer du code pour mon niveau en VBA , je sollicite votre aide car cela me facilitera grandement dans mes taches pour mon travail..

Si vous pouvez me fournir un code remodelé avec votre savoir faire pour accomplir ma requête ce serait très apprécié

En vous remerciant par avance de m'avoir lu.

Bonjour,

Pouvez-vous joindre le fichier original d'Arturo ainsi que le lien vers le fil en question ? Merci.

Un peu difficile à appréhender sans, surtout que certaines variables sont nommées "en dur".

Bonjour Saboh12617, merci pour votre participation et oui bien sûr que je peux mettre le lien vers le fil en question que voici :

https://forum.excel-pratique.com/excel/copier-des-donnees-selon-un-seuil-de-valeur-comprise-entre-x-...

Vous trouverez en téléchargement le fichier que Arturo83 m'avait proposé avec les petites modifications qui ont suivi..

J'avais par ailleurs pensé à remonter le fil de discussion en question en postant dessus, puisque c'est Arturo83 qui avait écrit le code mais comme le sujet était résolu je n'ai pas osé et peut être que je me serait fait "grondé" par un modérateur

Et je sais qu'il y a beaucoup de personnes doués en Excel sur ce forum dont vous aussi j'imagine et comme le vous dites si bien il est souvent difficile d'appréhender le sens d'un code ou une demande d'aide, et c'est pourquoi je met toujours une petite démo ou j’explique au mieux mon problème mais souvent cela ne suffit pas et je comprends tout à fait.

Si vous avez d'autres questions n'hésitez pas

J'ai refait une démo pleinement fonctionnel (j'y ai passé la journée à adapter le code) pour montrer comment fonctionne le principe du code et à quoi correspond chaque critères.. donc plus d'excuses si on ne comprends pas!

j’espère trouver la solution grâce à vous car j'ai eu beau essayer avec des tutos et de multiples essais, je ne sais pas comment appliquer une boucle dans ce cas ci..

15demo-2.xlsm (84.37 Ko)
Rechercher des sujets similaires à "mettre place boucle macro existante"