Boucle FOR avec 2 variables

Version imprimable

1 pièce(s) jointe(s)

Bonsoir, je galére sur une double boucle FOR, en gros je me retrouve avec une liste de référence rattaché à des Stocks, mais certaine réf sont à 0, j'aimerais donc copier coller les ref cartouche mais pas quand elles sont à 0 dans le stock dit...
Avec un copié coller du dépot rattaché...
Pas clair! je sais donc dans le fichier joint les deux feuilles Stock et tri, le stock c'est les data le tri c'est ce que j'attends, la macro est ok pour une seule collonne de stock, j'aimerais qu'elle pousse jusque 10 collones sauf si elles sont vides.
La premiére boucle est ok, mais je calle sur la suite!
PS j'ai récup la formule ici que j'ai adapté, je bidouille en vba, mais pas plus!
Pièce jointe 608501
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 Dim Txt, Nbr_ligne, Nbr_Stock, TRI, STOCK Set TRI = ThisWorkbook.Worksheets("Tri") Set STOCK = ThisWorkbook.Worksheets("Stock") Application.ScreenUpdating = False TRI.Range("A2:C6000").ClearContents Nbr_Stock = WorksheetFunction.CountA(STOCK.Range("B1:J1")) For Each Txt In STOCK.Range("A2:A" & STOCK.Range("A" & Rows.Count).End(xlUp).Row) If Txt.Offset(0, 1) <> 0 Then Nbr_ligne = TRI.Range("B" & Rows.Count).End(xlUp)(2).Row STOCK.Range("A" & Txt.Row & ":B" & Txt.Row).Copy TRI.Range("B" & Nbr_ligne).PasteSpecial Paste:=xlPasteValues STOCK.Range("B1").Copy TRI.Range("A" & Nbr_ligne).PasteSpecial Paste:=xlPasteValues End If Next Txt

Salut
Si vous cherchez à copier par poste les cartouche dont la qté est différente de zéro de stock vers tri ce qui suit fera le job.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub CopierColler()
Dim i As Long, j As Long
Dim DernLig As Long, DernCol As Long
 
With Worksheets("Stock")
    DernLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    DernCol = .Cells(1, Application.Columns.Count).End(xlToLeft).Column
    For i = 2 To DernCol
        For j = 2 To DernLig
            If .Cells(j, 2).Value <> 0 Then
                .Cells(1, i).Copy Worksheets("Tri").Range("A" & Rows.Count).End(xlUp).Offset(1)
                .Range(Cells(j, 1), Cells(j, 2)).Copy Worksheets("Tri").Range("B" & Rows.Count).End(xlUp).Offset(1)
            End If
        Next j
    Next i
End With
End Sub

Bonjour,

Autre proposition avec votre tableau converti en tableau structuré (plus de souci pour comptabiliser le nombre de lignes ou de colonnes)
La restitution dans la feuille "TRI", reprend les couleurs des entêtes de chaque référence de la feuille "STOCK".

le code

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Option Explicit
 
Sub Trier_CRT()
    Dim Nbr_Stock As Long, DerLig As Long, Lig_Dest As Long, i As Long, j As Long, Lig_Deb As Long, Couleur As Long
    Dim Ref As String
    Dim TRI As Worksheet, STOCK As Worksheet
 
    Application.ScreenUpdating = False
    Set TRI = ThisWorkbook.Worksheets("Tri")
    Set STOCK = ThisWorkbook.Worksheets("Stock")
    TRI.Cells.Clear
    DerLig = STOCK.ListObjects("Tableau1").DataBodyRange.Rows.Count + 1
    Nbr_Stock = STOCK.ListObjects("Tableau1").DataBodyRange.Columns.Count
    Lig_Dest = 2
    Lig_Deb = 2
    For i = 2 To Nbr_Stock
        Ref = STOCK.Cells(1, i)
        For j = 2 To DerLig
            If STOCK.Cells(j, i) <> 0 Then
                Range(TRI.Cells(Lig_Dest, "A"), TRI.Cells(Lig_Dest, "C")) = Array(Ref, STOCK.Cells(j, "A"), STOCK.Cells(j, i))
                Lig_Dest = Lig_Dest + 1
            End If
        Next j
        Couleur = STOCK.Cells(1, i).Interior.Color
        Range(TRI.Cells(Lig_Deb, "A"), TRI.Cells(Lig_Dest - 1, "C")).Interior.Color = Couleur
        Lig_Deb = Lig_Dest
    Next i
    Range(TRI.Cells(1, "A"), TRI.Cells(1, "C")) = Array("DEPOT", "Crt", "Nbr Cop")
    Range(TRI.Cells(1, "A"), TRI.Cells(1, "C")).Interior.Color = RGB(191, 191, 191)
    TRI.Select
    Set TRI = Nothing
    Set STOCK = Nothing
End Sub

le fichier
Pièce jointe 608511

Cdlt

11/11/2021, 10h16
Djamuka

Bonjour, et merci à vous deux pour le retour, les deux bouts de code fonctionne comme demandé :)

Je vais utiliser le code de ARTURO83 qui ne mouline pas et donne le résultat cash, sachant que le tableau risque d'avoir une multitude de ligne en plus vaut mieux que le tri soit réactif.

Encore merci à vous deux.