Changer code pour supprimer au lieu d'effacer ligne.

DAVID-44-

XLDnaute Occasionnel
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.

Code:
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
 
Dernière édition:

vgendron

XLDnaute Barbatruc
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)

XLDnaute Barbatruc
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-

XLDnaute Occasionnel
Bonjour vgendron,
Pourtant avec ce code ça fonctionne !
Merci quand même pour votre réponse.
VB:
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
 

Discussions similaires

Réponses
6
Affichages
202