Microsoft 365 Recherchev en VBA ?

[akira21]

Bonjour,

Je recherche la possibilité de copier le tableau qui est dans la feuille Extract Stock vers la feuille Extract STV mais que les lignes dont les codes sont dans la feuille BDD ?

Pouvez vous m'aider svp ?

Merci à vous

 

[sylvanu]

Bonjour Akira,
Un essai en PJ avec :

Sub Recherche()
Sheets("Stock STV").Range("A5:T10000").ClearContents
Application.ScreenUpdating = False
tablo = Sheets("Extract Stock").Cells(4, "A").CurrentRegion
TBDD = Sheets("BDD").Range("A1").CurrentRegion
Lstock = 5
For i = 2 To UBound(TBDD)
    On Error Resume Next
    Ligne = Application.Match(TBDD(i, 1), [CodeArt], 0)
    If Not IsError(Ligne) Then
        Ligne = Ligne - 3
        For Col = 1 To 20
            Sheets("Stock STV").Cells(Lstock, Col) = tablo(Ligne, Col)
        Next Col
        Lstock = Lstock + 1
    End If
Next i
End Sub

Par contre je n'ai pas compris, j'ai plusieurs lignes avec le même code article dans Extract Stock, donc dans la macro je ne prends que le premier. ( ou est ce normal car il y a plusieurs articles en stock ? )

 

[akira21]

Bonjour Akira,
Un essai en PJ avec :

Sub Recherche()
Sheets("Stock STV").Range("A5:T10000").ClearContents
Application.ScreenUpdating = False
tablo = Sheets("Extract Stock").Cells(4, "A").CurrentRegion
TBDD = Sheets("BDD").Range("A1").CurrentRegion
Lstock = 5
For i = 2 To UBound(TBDD)
    On Error Resume Next
    Ligne = Application.Match(TBDD(i, 1), [CodeArt], 0)
    If Not IsError(Ligne) Then
        Ligne = Ligne - 3
        For Col = 1 To 20
            Sheets("Stock STV").Cells(Lstock, Col) = tablo(Ligne, Col)
        Next Col
        Lstock = Lstock + 1
    End If
Next i
End Sub

Par contre je n'ai pas compris, j'ai plusieurs lignes avec le même code article dans Extract Stock, donc dans la macro je ne prends que le premier. ( ou est ce normal car il y a plusieurs articles en stock ? )

Bonsoir Sylvanu,

Merci pour ton aide

Effectivement, c'est normal car il peut y avoir le même article mais plusieurs lots.
Donc il faut bien tout prendre et non le 1er.

Encore un grand merci pour ton aide

 

[sylvanu]

Dans ce cas, pourquoi ne pas mettre la quantité ?

 

[akira21]

Dans ce cas, pourquoi ne pas mettre la quantité ?

Je ne peux pas, il faut vraiment récupérer les lignes telles qu'elle car à la place de test dans les cellules, j'ai d'autres infos qui ne sont pas identiques même si c'est le même code ou lot.
Trop de facteur à prendre en compte.
En gros, une ligne = une palette, chaque palette à son SSCC, son blocage qualité ou non, etc...
Toutes ses infos sont normalement à la place des "test" dans les cellules.
J'ai juste transmis dans le fichier, la mise en forme de l'extract stock car je ne peux pas transmettre les données :/

 

[Jacky67]

Bonjour,

Je recherche la possibilité de copier le tableau qui est dans la feuille Extract Stock vers la feuille Extract STV mais que les lignes dont les codes sont dans la feuille BDD ?

Pouvez vous m'aider svp ?

Merci à vous

Bonjour à tous
Une proposition avec ce code

Sub extractionJJ()
    Dim C As Range, Plage, Lig&
    Feuil5.Range("a5:t" & Rows.Count).Clear
    Application.ScreenUpdating = False
    Set Plage = Feuil4.Range("A4").CurrentRegion
    For Each C In Feuil6.Range("a2:a" & Feuil6.Cells(Feuil6.Rows.Count, "A").End(xlUp).Row)
        Plage.AutoFilter Field:=4, Criteria1:=C
        If Application.Subtotal(103, Plage.Columns("d")) > 1 Then
            Lig = Feuil5.Cells(Feuil5.Rows.Count, "D").End(xlUp).Row + 1
            Plage.Offset(1).Resize(Plage.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy Feuil5.Cells(Lig, 1)
        End If
    Next
    Plage.AutoFilter Field:=4
End Sub

 

[akira21]

Bonjour à tous
Une proposition avec ce code

Sub extractionJJ()
    Dim C As Range, Plage, Lig&
    Feuil5.Range("a5:t" & Rows.Count).Clear
    Application.ScreenUpdating = False
    Set Plage = Feuil4.Range("A4").CurrentRegion
    For Each C In Feuil6.Range("a2:a" & Feuil6.Cells(Feuil6.Rows.Count, "A").End(xlUp).Row)
        Plage.AutoFilter Field:=4, Criteria1:=C
        If Application.Subtotal(103, Plage.Columns("d")) > 1 Then
            Lig = Feuil5.Cells(Feuil5.Rows.Count, "D").End(xlUp).Row + 1
            Plage.Offset(1).Resize(Plage.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy Feuil5.Cells(Lig, 1)
        End If
    Next
    Plage.AutoFilter Field:=4
End Sub

Bonsoir Jacky67,

Merci, c'est exactement ce que je cherchais

Encore un grand merci pour ton aide

Bonne soirée