Supression de lignes
Bonsoir le forum,
Soit un ou des produits en rupture de stock dont les dates sont en zone rouge.
J'aimerais une suppression de ligne automatique 10 jours après la date inscrite en zone verte.
J'ai mis volontairement le fichier en *.xlsm car je pense qu'il y aura du VBA dans l'air
Merci d'avance
Bonjour,
Code à mettre dans le "ThisWorkbook" dans la partie VBA d'excel, et en modifiant le "Feuil1" avec le nom réél de ta feuille :
Private Sub Workbook_Open()
Dim i As Integer
i = 7
Do While Worksheets("Feuil1").Range("A" & i) <> ""
If Worksheets("Feuil1").Range("G" & i) = Date - 10 OR Worksheets("Feuil1").Range("G" & i) < Date - 10 Then
Worksheets("Feuil1").Range("A" & i).EntireRow.Delete
Else
i = i + 1
End If
Loop
End SubA chaque ouverture du fichier, il vérifie toutes les lignes et si la date en colonne G est = ou inférieur à la date du jour -10, la ligne est effacée.
Cordialement,
Bonjour,
un message d'erreur avec ton code
Private Sub Workbook_Open()
Dim i As Integer
i = 7
Do While Worksheets("Feuil1").Range("A" & i) <> ""
If Worksheets("Feuil1").Range("G" & i) = Date - 10 Or Worksheets("Feuil1").Range("G" & i) < Date - 10 Then
Worksheets("Feuil1").Range("A" & i).EntireRow.Delete
Else
i = i + 1
End If
Loop
End Sub
le message dit : "impossible d'exécuter le code en mode arrêt"
Mais j'ai reçu mieux entre temps :
Private Sub Workbook_Open()
Dim FeuilDonnees As Worksheet, FeuilHisto As Worksheet
Dim Cel As Range, ColRegul As Range
Dim DerCel As Range
Application.ScreenUpdating = False
Set FeuilDonnees = Sheets("Donnees")
Set FeuilHisto = Sheets("Histo")
Set DerCel = FeuilHisto.Cells(Rows.Count, "A").End(xlUp)(2)
Set ColRegul = FeuilDonnees.Range("G7:G44")
For Each Cel In ColRegul
If IsDate(Cel.Value) And Cel.Value <> "" Then
If Cel.Value + 10 < Date Then
Set DerCel = FeuilHisto.Cells(Rows.Count, "G").End(xlUp)(2).Offset(, -6)
With Cel.Offset(, -6).Resize(1, 7)
.Copy DerCel
.ClearContents
End With
End If
End If
Next Cel
With FeuilDonnees
.ListObjects("Tableau1").Sort.SortFields. _
Add Key:=Range("Tableau1[Régularisé le]"), SortOn:=xlSortOnValues, Order _
:=xlDescending, DataOption:=xlSortNormal
With .ListObjects("Tableau1").Sort
.Header = xlYes
.Apply
End With
End With
End Sub
Merci de ta contribution quand même 8)
Bizarre cela fonctionne chez moi, tu as bien mis le code puis sauvegardé et fermé / réouvert le classeur ?
Enfin de ce que je vois dans le 2eme code qu'on t'as fournis, le traitement prend en compte 2 feuilles différentes, ce qui n'était pas précisé dans ton énoncé.
Si tu pouvais fournir le classeur ou tu as adapté mon code pour voir stp que j'essai de voir d'ou vient le problème quand même ?
En piece jointe ton fichier ou j'ai fais mes tests, rentre n'importe quoi en colonne A, mets en colonne G (pour chaque ligne ou tu as remplis la colonne A) tes dates avec certaines devant être effacées et d'autres non, sauvegarde, et réouvre le classeur, tu verras que celles devant être effacées auront disparues.
Cordialement,
Re,
Oui effectivement, j'ai oublié de dire que j'avais 2 onglets.
Je suis sur Excel 2010, je ne sais pas si les codes jouent en fonction de la version mais bon.....
Voici le fichier
Re,
Bon déjà à l'ouverture du fichier ca m'a annoncé des données corrompues, et mon code ne pouvait pas fonctionné car tu n'avais pas renommé les "Feuil1" avec le nom réel de ta feuille comme indiqué.
En fichier joint ton fichier V2 avec mon code mis à jour avec le bon nom de feuille et cela fonctionne :p
Cordialement,