Je n'ai rien fourni pour la feuille stock .
Le worksheet_change au post
4 concerne uniquement la feuille "sortie du jour".
Bonjour Fanch55,
je suis vraiment désolé de vous embêter à ce point, mais j'ai du mal à comprendre .
Le code ci-dessous je l'ai placé dans la feuille "STOCK"
"Private Sub Worksheet_Activate()
If [Tableau2].ListObject.AutoFilter Is Nothing Then
[Tableau2].AutoFilter
End If
End Sub"
Est ce correct ?
Ensuite le code ci-dessous je l'ai placé dans la feuille "SORTIE DU JOUR"
Private Sub Worksheet_Change(ByVal Target As Range)
" If Target.Address = [B2].Address Then
Range("D2
" & WorksheetFunction.Max(2, Cells(Rows.Count, "D").End(xlUp).Row)).Clear
[Tableau2].ListObject.Range.AutoFilter
[Tableau2].ListObject.Range.AutoFilter Field:=2, Criteria1:="=" & [B2] & "*", Operator:=xlAnd
[Tableau2].ListObject.Range.AutoFilter Field:=5, Criteria1:=">0", Operator:=xlAnd
[Tableau2[Désignation]].SpecialCells(xlCellTypeVisible).Copy [D2]
[Tableau2].ListObject.Range.AutoFilter
End If
End Sub"
Est ce correct?
Mais si je veux éxecuter ce code il m'ouvre la fenêtre des macros !
Voici tout ce qui a dans la feuille "SORTIE DU JOUR"
Private Sub Worksheet_Change(ByVal Target As Range)
' Macro1 Macro
'
'
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False
Sheets("STOCK").Range("B1:B1685").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets("SORTIE DU JOUR").Range _
("B1:B2"), CopyToRange:=Range("D1"), Unique:=False
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim derniereligne As Integer
'affiche le numéro de la dernière ligne de la colonne F
derniereligne = Range("F" & Rows.Count).End(xlUp).Row
' Ne fonctionne que si les produits sont triés en colonne B
If Target.Count = 1 Then
If Not Intersect(Target, [D1
1685]) Is Nothing Then
'trouver, en colonne B, la position de la 1re occurence du produit
ligneDépart = Application.Match(Target, [D1
1685], 0)
'trouve la dernière ligne de la colonne F et décale cette ligne vers le bas grace au +1
Range("F" & derniereligne + 1).Value = Target
End If
End If
Cancel = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = [B2].Address Then
Range("D2
" & WorksheetFunction.Max(2, Cells(Rows.Count, "D").End(xlUp).Row)).Clear
[Tableau2].ListObject.Range.AutoFilter
[Tableau2].ListObject.Range.AutoFilter Field:=2, Criteria1:="=" & [B2] & "*", Operator:=xlAnd
[Tableau2].ListObject.Range.AutoFilter Field:=5, Criteria1:=">0", Operator:=xlAnd
[Tableau2[Désignation]].SpecialCells(xlCellTypeVisible).Copy [D2]
[Tableau2].ListObject.Range.AutoFilter
End If
End Sub
Merci à vous pour votre réponse.
Cdt Rubis54