Historisation d'une recherche par macro

Bonjour,

Je viens vous solliciter pour améliorer une macro que j'ai faite via enregistrement.

Lorsque l'on choisit un produit et une désignation produit en A16 et B16 (Onglet Budget), des données apparaissent dans les 2 tableaux en bas (données issus de l'onglet "plan de maintenance prev").

J'ai fais une macro bête et méchante pour créer un historique de mes recherches, lorsque je clique sur "Enregistrer la recherche" cela va copier coller la ligne pour la coller dans la zone appropriée.

Lors de l'enregistrement de ma macro, j'ai effectué mes collages sur la ligne 20. Or, il s'agit d'un filtre avec 4 possibilités...

Je souhaiterais en faite que l'historique enregistre la ligne figurante sous le titre "Formation" qui peut donc être la ligne 20, 21, 22 ou 23, selon ce qu'on a mis dans le filtre.

Quelqu'un aurait une idée ?

Merci d'avance pour votre aide

Fichier plus de 1000MO, voici mon drive :

Bonjour Fredo025

Voici ton code légèrement optimisé (pas besoin des select)

Private Sub CommandButton1_Click()
  Dim Lig As Long
  ' Définir la ligne sélectionnée
  Lig = ThisWorkbook.Sheets("Budget").Range("A19").End(xlDown).Row
  If Lig = 33 Then
    MsgBox "Aucun résultat à copier"
    Exit Sub
  End If
  'Selection des colonnes à mettre dans historique
    Cells(36, 1).EntireRow.Insert Shift:=xlDown
    Range("B1").Copy
    Range("A36").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Range("A16").Copy
    Range("B36").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Range("B16:C16").Copy
    Range("C36").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Range("A" & Lig & ":D" & Lig).Copy
    Range("D36").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Range("F" & Lig).Copy
    Range("H36").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Range("G" & Lig).Copy
    Range("I36").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Range("C7").Copy
    Range("J36").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Range("J" & Lig).Copy
    Range("K36").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Range("C8").Copy
    Range("L36").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Range("B9").Copy
    Range("M36").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Range("B11").Copy
    Range("N36").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Range("B13").Copy
    Range("O36").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    'Conversion au format date voulue
    Range("A36").NumberFormat = "dd/mm/yyyy hh:mm:ss"
    'Tri : montant ou descendant (ascending or descending)
    With ThisWorkbook.Worksheets("Budget")
      With .ListObjects("Tableau2").Sort
        With .SortFields
        .Clear
        .Add2 Key:=Range("Tableau2[Date]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        End With
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 End With
End Sub

A+

Merci beaucoup,

Cela fonctionne, mais j'ai une erreur de debogage à chaque fois que je clique sur 'Enregistrer la recherche"

Erreur d'exécution 439

Propriété ou méthode non gérée par cet objet

Apparemment c'est cette ligne qui pose problème :

.Add2 Key:=Range("Tableau2[Date]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

Cordialement,

Fred

Bonjour,

Essayer cette correction :

    With ThisWorkbook.Worksheets("Budget")
        With .ListObjects("Tableau2").Range
            .Sort key1:=.ListColumns("Date"), Order:=xlAscending, Header:=xlYes
        End With
    End With

Merci de ta correction, mais même problème.

Le problème vient de la macro qui vient juste après le copié/collé, celle ci permettait de trié les données par date de façon automatique,

J'ai dégagé cette partie comme ça pas de problème,

Merci à vous de votre aide,

Fred

Bonjour,

Tu n'aurais pas changé le nom de ton tableau par hasard

Sur ton fichier donné en partage, le code fonctionne parfaitement

Bruno,

juste parce que j'aime bien aller au bout des problèmes (ou plutôt des mystères), je te joins en copie le fichier de partage auquel j'ai rajouté ton code (qui remplace le mien), de mon côté ça fait toujours le débogage,

a mon avis j'ai fais une bourde quelque part mais je ne vois pas comment, j'avais qu'un copier/coller à faire

merci à toi,

Fred

lien :

Re,

Quelles sont les manipulations (étape par étape) que tu effectues pour avoir le bug

De mon côté toujours pas

Disons que...je double clique sur le fichier pour l'ouvrir, je clique sur "Enregistrer la recherche",

et ceci apparaît

Re,

Peux-tu cliquer sur débogage et faire une copie d'écran ?

Bien sûr,

et voici !

Re,

Et si tu remplaces tout simplement ".Add2" par ".Add"

Mystère résolu, ça marche !

Cela dit, étonnant qu'avec toi le add2 marche, sauf si tu l'as changé sans me l'avoir dit ,

Merci en tout cas

Re,

Je suis sous Office 365 donc certaines nouveautés n'existent pas sur 2016