Discussion :

[Djamuka]

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!
Tri_Stock.xlsm

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[hyperion13]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[ARTURO83]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[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.