Changer code pour supprimer au lieu d'effacer ligne.

[DAVID-44-]

Bonjour à tous,
J'ai besoin d'un petit coup de main !

Que faut-il changer dans ce code pour supprimer les lignes dans "Stock" au lieu de simplement effacer le contenu et sans décaler l'ensemble de la feuille ?
J'ai essayé "Delete" à la place de "ClearContents", ça supprime bien la ligne, mais ça décale tout le tableau !

Merci de votre aide.

Sub Worksheet_Activate()
    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
    Lig = 1 + f2.Range("B65500").End(xlUp).Row
    Stock = f1.Range("B9:K" & DerLig_f1)
    ReDim Prevu(1 To UBound(Stock), 1 To 10)
   
    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, "A"), 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

 

[vgendron]

Salut
il y a un problème de vocabulaire et comprehension.
supprimer = la ligne disparait ==> donc forcément, ca décale le reste
effacer: la ligne reste mais son contenu est vidé ==> la ligne reste à sa place et rien n'est décalé..
c'est l'un ou l'autre, mais pas les deux

Supprimer = delete
effacer = clearcontents ou Clear (clearcontents efface le contenu mais garde la mise en forme, alors que clear efface contenu ET mises en forme)

 

[youky(BJ)]

Salut le motard, et au forum,
A essayer car comme dit vgendron c'est l'un ou l'autre.
Ceci supprime la ligne complète

A remplacer
For i = LBound(Stock) To UBound(Stock)
par 'on part du bas et on remonte
For i = UBound(Stock) To LBound(Stock) Step-1

et remplacer
f1.Range(f1.Cells(i + 8, "A"), f1.Cells(i + 8, "K")).ClearContents
par
f1.rows(i+8).delete

Bruno

 

[DAVID-44-]

Bonjour vgendron,
Pourtant avec ce code ça fonctionne !
Merci quand même pour votre réponse.

Sub Worksheet_Activate()
    DerLigDeb = Range("G65500").End(xlUp).Row
    LenCours = 1 + DerLigDeb
    For L = 400 To 9 Step -1
        If IsDate(Sheets("STOCK").Cells(L, "I")) And Sheets("STOCK").Cells(L, "I") <= Date + 7 _
            And Sheets("STOCK").Cells(L, "I") >= Date Then
            Sheets("Urgent").Cells(LenCours, "B") = Sheets("STOCK").Cells(L, "B")
            Sheets("Urgent").Cells(LenCours, "C") = Sheets("STOCK").Cells(L, "C")
            Sheets("Urgent").Cells(LenCours, "E") = Sheets("STOCK").Cells(L, "G")
            Sheets("Urgent").Cells(LenCours, "F") = Sheets("STOCK").Cells(L, "F")
            Sheets("Urgent").Cells(LenCours, "G") = Sheets("STOCK").Cells(L, "I")
            Sheets("STOCK").Rows(L).Delete shift:=xlUp
            LenCours = LenCours + 1
        End If
    Next L
    Range("B9:G100").Select
    ActiveWorkbook.Worksheets("URGENT").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("URGENT").Sort.SortFields.Add Key:=Range("G9:G100") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("URGENT").Sort
        .SetRange Range("B9:G100")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    [B2].Select
End Sub

 

[DAVID-44-]

Bonjour youky(BJ),
Ok je vais essayer.
Merci beaucoup pour le coup de main 🙂
Bonne journée à tous.

 

[vgendron]

Pourtant avec ce code ça fonctionne !

il y a vraisemblablement un problème de compréhension..
si ca fonctionne.. bah, c'est quoi le problème alors ??
Faudrait que tu postes ton fichier en indiquant clairement ce que tu souhaites avoir

 

[DAVID-44-]

Bonjour youky(BJ) et vgendron,
Essai concluant ! Ça fonctionne.
Merci beaucoup pour l'aide.
Passer un bon week-end.