XL 2016 VBA : Copie d'une ligne après application d'un filtre

[gfgghbhg]

Bonjour à tous,

Dans le cadre de mon travail, j'ai réalisé un fichier Excel qui contient de la matière en stock. J'ai réalisé plusieurs macros permettant d'insérer, de rechercher des éléments dans la base de données..
Le problème que je rencontre est sur la macro de "changement de feuille", lancé par le bouton "passage de stock à utiliser".
J'applique un filtre, pour ensuite copier ou couper la ligne qui ressort via le filtre. Or lors de l'opération de copier/coller, la ligne copier n'est pas celle du filtre actif mais la première ligne de la base de données sans les filtres. Je ne sais pas si je suis très clair.

Voici la macro en question.

Sub Changement_fiche()

Dim L As Integer


Sheets("Stock").Select
Lot = InputBox("Quel est le lot souhaité? ", "Saisie lot")

Sheets("Stock").Select
Range("Tableau4[[#Headers],[Numéro de lot]]").Select
ActiveSheet.ListObjects("Tableau4").Range.AutoFilter Field:=1, Criteria1:=Lot

d = [Subtotal(3, A:A)]
If d > 2 Then
Lon = InputBox("Quel est la longueur souhaité? ", "Saisie longueur")
Range("Tableau4[[#Headers],[Longueur (mm)]]").Select
ActiveSheet.ListObjects("Tableau4").Range.AutoFilter Field:=2, Criteria1:=Lon
d = [Subtotal(3, A:A)]
If d > 2 Then
Lar = InputBox("Quel est la largeur souhaité? ", "Saisie largeur")
Range("Tableau4[[#Headers],[Largeur (mm)]]").Select
ActiveSheet.ListObjects("Tableau4").Range.AutoFilter Field:=3, Criteria1:=Lar
d = [Subtotal(3, A:A)]
If d > 2 Then
Ep = InputBox("Quel est l'épaisseur souhaité? ", "Saisie épaisseur")
Range("Tableau4[[#Headers],[Epaisseur (mm)]]").Select
ActiveSheet.ListObjects("Tableau4").Range.AutoFilter Field:=4, Criteria1:=Ep
d = [Subtotal(3, A:A)]
If d <> 2 Then
Spec = InputBox("Quel est la spec souhaité? ", "Saisie spec")
Range("Tableau4[[#Headers],[Spec]]").Select
ActiveSheet.ListObjects("Tableau4").Range.AutoFilter Field:=5, Criteria1:=Spec
d = [Subtotal(3, A:A)]
End If
End If
End If
End If
If d = 1 Then
Call MsgBox("Il n'y a pas de matière sous ces données", Erreur)
ActiveSheet.ShowAllData
Exit Sub
End If
If Sheets("Stock").Range("F" & 2).Value = "Tole" Then
Sheets("Utilisé").Rows(2).Insert
Sheets("Stock").Range("A2:M2").Cut Sheets("Utilisé").Range("A2:L2")
Sheets("Stock").Select
Sheets("Stock").Rows(2).Delete
Range("Tableau4[#Headers]").Select
ActiveSheet.ShowAllData
Else
L = InputBox("Quel est le nombre de lopins à usiner ?", "Saisie lopins")
If L > Sheets("Stock").Range("G2").Value Then
Call MsgBox("Il n'y a pas autant de lopins disponible")
Sheets("Stock").Select
Range("Tableau4[#Headers]").Select
ActiveSheet.ShowAllData
ElseIf L = Sheets("Stock").Range("G2").Value Then
Sheets("Utilisé").Rows(2).Insert
Sheets("Stock").Range("A2:M2").Cut Sheets("Utilisé").Range("A2:L2")
Sheets("Stock").Select
Sheets("Stock").Rows(2).Delete
Range("Tableau4[#Headers]").Select
ActiveSheet.ShowAllData
Else
Sheets("Utilisé").Rows(2).Insert
Sheets("Stock").Range("A2:M2").Copy Sheets("Utilisé").Range("A2:L2")
Sheets("Utilisé").Range("G2") = L
Sheets("Stock").Select
Sheets("Stock").Range("G2") = Sheets("Stock").Range("G2") - L
Sheets("Utilisé").Range("L2") = L * Sheets("Utilisé").Range("J2").Value
Sheets("Utilisé").Range("M2") = L * Sheets("Utilisé").Range("K2").Value
Sheets("Stock").Range("L2") = Sheets("Stock").Range("G2") * Sheets("Stock").Range("J2").Value
Sheets("Stock").Range("M2") = Sheets("Stock").Range("G2") * Sheets("Stock").Range("K2").Value
Range("Tableau4[#Headers]").Select
ActiveSheet.ShowAllData
End If
End If
Dim DateSheet
DateSheet = InputBox("Quel est le jour de l'utilisation de cette matière ?", Date)
Sheets("Utilisé").Select
Range("N2").Select
ActiveCell.FormulaR1C1 = DateSheet
Call Somme_Stock
Call Somme_Utilisé
Sheets("Utilisé").Select
d = Cells(Rows.Count, 1).End(xlUp).Row
Rows("2:" & d).Font.Color = RGB(0, 0, 0)
Rows("2:" & d).Font.Bold = False
End Sub




Merci à vous pour votre aide futur

 

[mapomme]

Bonjour et bienvenue sur XLD

Voici une fonction VBA qui retourne le numéro de ligne de la première ligne filtrée dt tableau structuré filtré.

• en valeur absolue (par rapport à la feuille du tableau structuré)
• en valeur relatif (par rapport à la première ligne des données du tableau)
• renvoie0 le nombre 0 si le filtre ne retourne aucune ligne

Si le deuxième paramètre est présent (et vaut n'importe quoi) alors on retourne la valeur "en relatif).



La fonction en VBA à mettre dans un module ordinaire :

Function PremLigne(Tableau As ListObject, Optional relatif) As Long
Dim deb&, Lig1&, lig2&, i&
   With Tableau
      If .ListRows.Count = 0 Then Exit Function
      deb = .Range.Row + 1: Lig1 = deb: lig2 = deb + .ListRows.Count - 1
      For i = Lig1 To lig2
         If .Parent.Rows(i).Hidden = False Then Exit For
      Next i
      If i > lig2 Then Exit Function
      PremLigne = IIf(IsMissing(relatif), i, i - deb + 1)
   End With
End Function

La fonction test() associée au bouton:
Sub test()
   MsgBox "En absolu : " & PremLigne(Sheets("Feuil1").ListObjects("Tableau1"))
   MsgBox "En relatif : " & PremLigne(Sheets("Feuil1").ListObjects("Tableau1"), 123)
End Sub

nota: choisir un pseudo à peu près compréhensible, permet de se souvenir de vous et de vos demande

 

[gfgghbhg]

Bonjour,

Merci pour votre réponse,
Je comprends le fonctionnement, mais je ne sais pas comment l'intégrer dans ma ligne de C/C ci dessous

Sheets("Stock").Range("A2:M2").Copy Sheets("Utilisé").Range("A2:L2")

J'ai essayé de remplacer par cela, avec L la valeur de la ligne de la feuille

Sheets("Stock").Range("A" & L & ":M" & L).Copy Sheets("Utilisé").Range("A2:L2")

Pouvez-vous m'indiquer la démarche à réaliser svp ?

Ps : Etant un gameur à mes heures perdues, je suis sous ce pseudo depuis plusieurs années (je ne trouvais pas de pseudo qui me convenait et donc fait un spam click sur ma console. Depuis, j'ai toujours gardé ce pseudo ^^

 

[Phil69970]

Bonjour @gfgghbhg et @mapomme

Avec la même idée que @mapomme

Plutôt que de faire entrer 5 fois des valeurs à l'utilisateur avec les risques d'erreur * 5, j'ai commencé ceci :
==> Voir feuille stock
Tu as des tableaux structurés tu peux aussi t'en servir pour faire des calcul.... (voir colonne L et M feuille stock)

La suite suivant ton approbation ou pas !!!

@Phil69970

 

[gfgghbhg]

Bonjour @Phil69970,

Merci pour ta proposition. Le problème est qu'à l'avenir les feuilles stock et utilisé seront masqué. D'où le fait que je souhaite entrer 5 fois les valeurs.

Merci de ta proposition.

Gf

Ps: Etant en vacance ce soir je ne serais pas disponible avant milieu de semaine prochaine pour répondre à vos potentielles solutions.

 

[gfgghbhg]

Bonjour @mapomme,

Je reviens de vacances, et est donc pu tester votre solution plus en profondeur. Le problème est maintenant résolu, grâce à l'obtention du numéro de ligne, en modifiant les lignes de ce type :

Sheets("Stock").Range("A2:M2").Copy Sheets("Utilisé").Range("A2:L2")

Par

Sheets("Stock").Rows(Nl).Copy Sheets("Utilisé").Range("A2:L2")

Avec Nl correspondant au numéro de la ligne trouvé avec les différents filtres.

Merci à vous pour votre aide et bonne journée.
Gf

 

[Gérard_yeboua]

Erreurs innées de mon code: Loop Until Sheets(NomFeuille).Range ("A" & Derlinge). Value= " "

 

[gfgghbhg]

Bonjour @Gérard_yeboua,

Je n'ai pas compris votre message, vous faites référence à une erreur dans un de vos codes, ou bien dans le mien ? Si c'est dans un de vos codes, il faudra plus d'informations pour vous aider.

Cordialement
Gf