Réaliser une macro pilotée selon une fonction si

Bonjour à Tous,

Je suis sous Excel 2010 avec un classeur de gestion de stock qui comporte 2 feuilles : « ENTREES » et « ALERTE »

Sur la feuille « ENTREES » sur les colonnes « A » à « J » le descriptif de chaque article en stock et ceci de la ligne 4 à la ligne « x » (une ligne par référence).

Compte tenu que ces articles ont des dates limites de consommation, j’ai créé avec la fonction « si » l’affichage du mot « ALERTE » dans la colonne « K » en fonction de la date limite de consommation et ceci sur l’ensemble des lignes « 4 » à « x ».

Je souhaiterai utiliser une macro qui s’exécuterait automatiquement à l'ouverture de ce classeur, pour me recopier les colonnes « A » à «J » de chaque ligne qui affiche « ALERTE » en colonne « K », sur la feuille « ALERTE ».

Exemple : si sur la feuille « ENTREES » K6 ; K8 et K25 = « ALERTE », la macro copie automatiquement, sur la feuille « ALERTE » à partir de la ligne 1, les lignes 6 ; 8 et 25 colonnes « A » à « J » de la feuille « ENTREES »

En souhaitant être suffisamment explicite….

Je dois faire travail dans le cadre de l’association caritative qui m’a confiée cette mission. Je débute avec Excel et je n’arrive pas à trouver dans le forum une réponse compréhensible…. Je suis nul ! Qui peut m’aider ?

En vous remerciant

Bonjour,

Une proposition à étudier.

A l'ouverture du fichier les produits périmés (à la date du jour !) sont affichés en feuille 'Alerte'.

Cdlt.

Option Explicit
Option Private Module

Public Sub Alerte()
Dim wb As Workbook
Dim ws As Worksheet, ws2 As Worksheet
Dim lo As ListObject, lo2 As ListObject
Dim rStart As Range, rngFilter As Range

    Application.ScreenUpdating = False
    Set wb = ActiveWorkbook
    Set ws = wb.Worksheets("ENTREES")
    Set ws2 = wb.Worksheets("ALERTE")

    Set lo2 = ws2.ListObjects(1)
    If Not lo2.DataBodyRange Is Nothing Then lo2.DataBodyRange.Delete
    Set rStart = lo2.InsertRowRange.Cells(1)

    Set lo = ws.ListObjects(1)
    If lo.ShowAutoFilter Then lo.AutoFilter.ShowAllData
    lo.Range.AutoFilter field:=9, Criteria1:="<" & Format(Date, "m/d/yyyy")

    With lo.AutoFilter.Range
        On Error Resume Next
        Set rngFilter = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count) _
                        .SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
    End With

    If rngFilter Is Nothing Then
        MsgBox "Il n'y a pas d'alerte aujourdh'hui", vbInformation
    Else
        rngFilter.Copy
        rStart.PasteSpecial xlPasteValues
        Application.CutCopyMode = False
    End If

    lo.Range.AutoFilter field:=9

    With ws2
        .Activate
        .[A3].Select
    End With

    Set rStart = Nothing: Set rngFilter = Nothing
    Set lo2 = Nothing: Set lo = Nothing
    Set ws2 = Nothing: Set ws = Nothing
    Set wb = Nothing

End Sub

Bonjour

Code Module

Option Explicit
Sub Filtre()
    Application.ScreenUpdating = False
    Sheets("ALERTE").Activate
    Range("a1:k" & Range("b65000").End(xlUp).Row).Clear
    Sheets("ENTREES").Activate
    Range("o4") = "=k4=""ALERTE"""
    Range("a3:k" & Range("b65000").End(xlUp).Row).AdvancedFilter action:=xlFilterCopy, CriteriaRange:= _
    Range("o3:o4"), CopyToRange:=Sheets("ALERTE").Range("a1:k1"), Unique:=False
    Range("o4").ClearContents
    Sheets("ALERTE").Activate
End Sub

Code ThisWorkBook

Private Sub Workbook_Open()
Call Filtre
End Sub

Cordialement

Bonsoir et merci à vous deux pour cette aide

Je teste demain

Bonjour à vous Deux,

Merci pour votre aide! Ca tourne!....

Bonne journée à vous

ignorant