Boucle VBA avec conditions

Bonjour,

J'ai un problème avec mon code VBA suite à un changement dans mon activité. Jusqu'à présent, le code ci-dessous fonctionnait très bien pour mon usage (même si le code en lui même est très moche, mais bon...).

Le but de ce fichier est de me dire, en fonction de références que je lui donne, combien de pièces de chaque référence je dois faire venir sur mon site de production depuis mes autres sites de stockage.

Une première macro me génère le tableau en Feuil1 du fichier joint. Elle va chercher dans une base toutes les lignes qui correspondent aux 4 références en colonne A.

La deuxième macro analyse ce tableau en supprimant les lignes des palettes qui sont déjà sur mon site de prod, et me surligne puis me met dans un nouveau fichier les palettes que je dois rapatrier (grâce à la colonne cumul).

Aujourd'hui je travaille avec 4 références, ça fonctionne bien, mais demain je vais devoir travailler avec X références (10, 50,100, 500...), qui seront toutes dans la même colonne.

Vu mon code, ce n'est pas possible... Est-il possible de faire un code qui parcoure la colonne A jusqu'à la dernière ref et qui applique la mise en couleur selon les conditions déjà en place dans mon code ?

Merci pour votre aide !

Ci-dessous ma macro

Sub analysepal()
Dim Derlig As Long
Dim plage As Range
Dim cell As Range
Dim I As Integer

Derlig = Cells(Application.Rows.Count, 6).End(xlUp).Row
Set plage = Range("A7:K1000")

For I = [G65000].End(xlUp).Row To 1 Step -1
      If Cells(I, 7) = "DEPOT_4" Then Rows(I).Delete
      Next I

Range("K7").Select
    ActiveCell.FormulaLocal = "=SI(F6=F7;SI(G7<>Feuil1!$C$2;K6+H7;K6);H7)"
Range("K7").Select
Selection.AutoFill Destination:=Range("K7:K" & Derlig)

    If Not ActiveSheet.AutoFilterMode Then
    ActiveSheet.Range("F6:K6").AutoFilter
  End If
Range("F6:K" & Derlig).Select
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("F7:F" & Derlig) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("I7:I" & Derlig) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Feuil1").Sort
        .SetRange Range("F6:K" & Derlig)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

ActiveSheet.Range("$F$1:$K" & Derlig).AutoFilter Field:=4, Criteria1:="<>"
ActiveSheet.Range("$F$1:$K" & Derlig).AutoFilter Field:=2, Criteria1:="<>DEPOT_4"

For Each cell In plage
        If Range("$D$2") > 0 And Cells(cell.Row, 6) = Sheets("Feuil1").Range("$A$2") And Cells(cell.Row, 6) <> Cells(cell.Row - 1, 6) Then
        Cells(cell.Row, 9).Interior.ColorIndex = 6
        End If
        If Cells(cell.Row, 11) < Range("$D$2") And Cells(cell.Row, 6) = Sheets("Feuil1").Range("$A$2") And Cells(cell.Row, 9) <> "" Then
        Cells(cell.Row, 9).Interior.ColorIndex = 6
        Cells(cell.Row + 1, 9).Interior.ColorIndex = 6
        End If
        If Range("$D$3") > 0 And Cells(cell.Row, 6) = Sheets("Feuil1").Range("$A$3") And Cells(cell.Row, 6) <> Cells(cell.Row - 1, 6) Then
        Cells(cell.Row, 9).Interior.ColorIndex = 6
        End If
        If Cells(cell.Row, 11) < Range("$D$3") And Cells(cell.Row, 6) = Sheets("Feuil1").Range("$A$3") And Cells(cell.Row, 9) <> "" Then
        Cells(cell.Row, 9).Interior.ColorIndex = 6
        Cells(cell.Row + 1, 9).Interior.ColorIndex = 6
        End If
        If Range("$D$4") > 0 And Cells(cell.Row, 6) = Sheets("Feuil1").Range("$A$4") And Cells(cell.Row, 6) <> Cells(cell.Row - 1, 6) Then
        Cells(cell.Row, 9).Interior.ColorIndex = 6
        End If
        If Cells(cell.Row, 11) < Range("$D$4") And Cells(cell.Row, 6) = Sheets("Feuil1").Range("$A$4") And Cells(cell.Row, 9) <> "" Then
        Cells(cell.Row, 9).Interior.ColorIndex = 6
        Cells(cell.Row + 1, 9).Interior.ColorIndex = 6
        End If
        If Range("$D$5") > 0 And Cells(cell.Row, 6) = Sheets("Feuil1").Range("$A$5") And Cells(cell.Row, 6) <> Cells(cell.Row - 1, 6) Then
        Cells(cell.Row, 9).Interior.ColorIndex = 6
        End If
        If Cells(cell.Row, 11) < Range("$D$5") And Cells(cell.Row, 6) = Sheets("Feuil1").Range("$A$5") And Cells(cell.Row, 9) <> "" Then
        Cells(cell.Row, 9).Interior.ColorIndex = 6
        Cells(cell.Row + 1, 9).Interior.ColorIndex = 6
        End If

Next cell

    Selection.AutoFilter
    Range("F6:K6").Select
    Selection.AutoFilter
    ActiveSheet.Range("$F$6:$K$48").AutoFilter Field:=4, Criteria1:=RGB(255, _
        255, 0), Operator:=xlFilterCellColor
        ActiveSheet.Range("$F$6:$K$48").AutoFilter Field:=3, Criteria1:="<>0"
    ActiveSheet.Range("$F$1:$K" & Derlig).AutoFilter Field:=2, Criteria1:="<>DEPOT_4"
    Range("I6:I" & Derlig).Select
    Selection.SpecialCells(xlCellTypeVisible).Copy
    Workbooks.Add
    ActiveSheet.Paste
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\asa\Desktop\Palettes à rapatrier.xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False

End Sub

Bonjour Anthonny1992 le forum

ton fichier en retour avec mes modifs (enfin avec une macro qui est plus une macro!!!)

enfin si j'ai compris ce que tu veux (pas sur)

tu ouvres tu cliques tu regardes le résultat et et tu me redis

a+

Papou

Bonjour Papou,

Merci pour ta réponse rapide !

Sur ce fichier test ton code m'a l'air très bien, j'ai juste un question: je n'arrive pas à voir si ton code trie les palettes ou non ?

En effet, j'ai une autre contrainte que je n'ai pas forcément explicitée: j'ai besoin de récupérer les palettes les plus anciennes (n° de PAL le plus petit) en premier et on remonte jusqu'à la plus récente (une sorte de méthode FIFO).

Je testerai la macro dans la matinée sur mon vrai fichier (j'ai modifié les données de celui-ci pour des raison de confidentialité).

Merci pour ton aide !

Anthony

Re bonjour Anthonny1992 le forum

non pour le moment je n'ai pas tenu compte de ce paramètre car à vrai dire quand j'ai vu ta macro je l'ai jeté !!!

et j'ai fait une macro correcte, mais les conditions ne sont peut-être pas toutes respectées du coup, mais c'est pas un souci, je peux modifier, mais avec un faux fichier !!!! ???? est-ce que tu sauras ajuster la macro en cas de modifs?? vu tes macros pas sur du tout

enfin si besoin est je peux bosser sur ton vrai fichier mais dans ce cas je te donnerai une adresse email en MP

je te modifie la macro pour faire comme tu veux et je t'envoie dans 1/2 heure à peu près

dans l'attente de te lire

a+

Papou

Re Anthony le forum

la v2 avec les modifs

a+

Papou

Re-bonjour Papou

Ton fichier marche très bien, je te remercie tu me fais gagner beaucoup de temps.

Le code est affreux je sais bien, il résulte de mes nombreux tâtonnements en VBA. Il avait au moins le mérite de répondre à mon besoin, et c'était là le principal.

J'ai réglé mon problème du tri des palettes entre-temps, j'ai refait la macro qui extrait les données de ma base car mon fichier d'origine a été changé, j'en ai profité pour la simplifier et rajouter un tri des données à la fin (par ref puis par N° de pal).

Encore merci pour ton aide !

Anthony