Envoyer une ligne complète automatiquement d'une feuille à une autre.

[DAVID-44-]

Bonjour, je suis toujours avec mon classeur afin de gérer correctement les stocks, qui avance grâce à votre aide.

Je souhaiterais envoyer automatiquement des cellules de la feuille "STOCK" dans la feuille "PRÉVU LE" si une date est notée dans la colonne "PRÉVU LE" de la feuille "STOCK" et trier de haut en bas, les produits de la date les plus prêts à la date la plus éloignée de la colonne "PRÉVU LE".
En même temps, supprimer cette ligne dans feuille "STOCK".

Je reste à votre disposition pour d'éventuelles questions.

Merci de votre aide.

 

[Rouge]

Bonjour,

Essayez ceci, remplissez la feuille stock; puis cliquez sur le bouton pour le transfert
Le code dans un module standard:

Sub Exporter_Stock()
    Dim f1 As Worksheet, f2 As Worksheet
    Dim DerLig_f1 As Long, DerLig_f2 As Long, Lig As Long
    Dim i As Long
    Dim Strock As Range
    Application.ScreenUpdating = False
    Set f1 = Sheets("STOCK")
    Set f2 = Sheets("PREVU LE")
    f2.Range("B9:I100").ClearContents
    DerLig_f1 = f1.Range("B" & Rows.Count).End(xlUp).Row
    Stock = f1.Range("B9:K" & DerLig_f1)
    ReDim Prevu(1 To UBound(Stock), 1 To 10)
    Lig = 9
    For i = LBound(Stock) To UBound(Stock)
        If f1.Cells(i + 8, "J") <> "" And f1.Cells(i + 8, "J") <> "PRÉVU LE" Then
            f2.Range("B" & Lig & ":I" & Lig) = Array(Stock(i, 1), Stock(i, 2), Stock(i, 3), Stock(i, 4), Stock(i, 5), Stock(i, 8), Stock(i, 9), Stock(i, 10))
            f1.Range(f1.Cells(i + 8, "C"), f1.Cells(i + 8, "K")).ClearContents
            Lig = Lig + 1
        End If
    Next i
   
    If Lig > 10 Then
        DerLig_f2 = f2.Range("B" & Rows.Count).End(xlUp).Row
        f2.Range("B9:I" & DerLig_f2).Sort [H8], 1
    End If
End Sub

 

[DAVID-44-]

Bonjour, merci beaucoup c'est super.
J'ai encore une demande .
Est-il possible dé supprimer en même temps les lignes dans la feuille "STOCK" et trier de haut en bas, les produits de la date les plus prêts à la date la plus éloignée de la colonne "PRÉVU LE" ?
Merci beaucoup.

 

[Rouge]

Je n'ai pas supprimé les lignes dans "Stock" mais simplement effacé le contenu, ce qui d'une part les rend réutilisables et d'autre part vous évite de les recréer par la suite. maintenant si vous y tenez je peux le faire. En êtes-vous toujours sûr?

pour le tri inversé (remplacez 1 par 2 sur la ligne suivante
f2.Range("B9:I" & DerLig_f2).Sort [H8], 1

Ce qui donne
f2.Range("B9:I" & DerLig_f2).Sort [H8], 2

 

[DAVID-44-]

Re-bonjour, en fait c'est parfait.
Merci beaucoup.
Bonne journée.

 

[DAVID-44-]

Rebonjour, est-il possible quand quand on fait le transfère de ne pas effacer l'ancienne liste dans la feuille "PREVU LE" mais de compléter celle-ci ?
Merci de vos réponses.

 

[Rouge]

Bonjour,

Voici le nouveau code

Sub Exporter_Stock()
    Dim f1 As Worksheet, f2 As Worksheet
    Dim DerLig_f1 As Long, DerLig_f2 As Long, Lig As Long
    Dim i As Long
    Dim Strock As Range
    Application.ScreenUpdating = False
    Set f1 = Sheets("STOCK")
    Set f2 = Sheets("PREVU LE")
    
    DerLig_f1 = f1.Range("B" & Rows.Count).End(xlUp).Row
    DerLig_f2 = f2.Range("B" & Rows.Count).End(xlUp).Row
    Stock = f1.Range("B9:K" & DerLig_f1)
    ReDim Prevu(1 To UBound(Stock), 1 To 10)
    Lig = 9
    For i = LBound(Stock) To UBound(Stock)
        If f1.Cells(i + 8, "J") <> "" And f1.Cells(i + 8, "J") <> "PRÉVU LE" Then
            f2.Range("B" & DerLig_f2 + 1 & ":I" & DerLig_f2 + 1) = Array(Stock(i, 1), Stock(i, 2), Stock(i, 3), Stock(i, 4), Stock(i, 5), Stock(i, 8), Stock(i, 9), Stock(i, 10))
            f1.Range(f1.Cells(i + 8, "C"), f1.Cells(i + 8, "K")).ClearContents
            Lig = Lig + 1
            DerLig_f2 = DerLig_f2 + 1
        End If
    Next i
    f2.Select
    If Lig > 10 Then
        DerLig_f2 = f2.Range("B" & Rows.Count).End(xlUp).Row
        f2.Range("B9:I" & DerLig_f2).Sort [H8], 2
    End If
End Sub

Cdlt

 

[DAVID-44-]

Bonjour, merci beaucoup. C'est parfait.
Bonne journée.