Macro CTRL + F avec variable et export dans une feuille

[bonoboas]

Bonjour,

Je ne suis pas très en fort en macro, mais depuis quelque temps je me demande si cela est possible.
A ce jour, je fais tout cela à la main ce qui est très fastidieux:
je fais un CTRL+F pour une recherche dans tout le classeur (environ 8 feuilles), je tape ma variable par exemple : lavabo, je clique sur le résultat de la recherche, ensuite j'exporte par copiage-collage spéciale valeur des colonnes M, N, O, P, R, S, T de la ligne concernée dans la feuille export. Je répète la manipe jusqu'à la dernière feuille. Puis rebelotte, avec baignoire, clapet...etc.

Je vous joins un échantillon de mon fichier pour vous montrer à quoi ça ressemble.

Merci,

Anthony

 

[Dranreb]

Re : Macro CTRL + F avec variable et export dans une feuille

Bonjour

Comme ça, ça paraît pas mal :

Private Sub Worksheet_Activate()
Dim T(), LstCr(), Ls As Long, ZCrit As String, N As Long, ET As Boolean, TCrit() As String, Feui As Worksheet, _
   L As Long, CEstOK As Boolean, Z As String, K As Long, TRés(1 To 2, 1 To 8), C As Long
LstCr = FCrit.Range("A1:A" & FCrit.[A65536].End(xlUp).Row).Value
Ls = -1
Application.ScreenUpdating = False
Me.Rows("6:65536").Delete
For N = 1 To UBound(LstCr)
   ZCrit = LstCr(N, 1)
   ET = InStr(ZCrit, ";") > 0: TCrit = Split(UCase(ZCrit), IIf(ET, ";", "*"))
   Ls = Ls + 2
   If Ls > 1 Then Me.Rows("1:3").Copy Destination:=Me.Rows(Ls)
   Me.Rows(Ls + 3).Resize(2).ClearContents
   Me.Cells(Ls, "B").Value = ZCrit
   Ls = Ls + 2
   For Each Feui In Worksheets
      If Feui.Index = Me.Index - 1 Then Exit For
      T = Feui.[M2:U2].Resize(Feui.UsedRange.Rows.Count - 1).Value
      For L = 1 To UBound(T)
         Z = UCase(T(L, 1))
         CEstOK = ET
         For K = 0 To UBound(TCrit)
            If Z Like "*" & TCrit(K) & "*" Then
               If Not ET Then CEstOK = True: Exit For
            ElseIf ET Then
               CEstOK = False: Exit For: End If
            Next K
         If CEstOK Then
            Ls = Ls + 1
            Me.[A4:H5].Copy Me.[A:H].Rows(Ls)
            TRés(1, 1) = T(L, 2): TRés(1, 2) = T(L, 3): For C = 3 To 8: TRés(1, C) = T(L, C + 1): Next C
            TRés(2, 2) = T(L, 1)
            Me.[A:H].Rows(Ls).Resize(2).Value2 = TRés: Me.Cells(Ls, "G").FormulaR1C1 = "=RC[-1]*RC[-2]"
            Ls = Ls + 1: End If
         Next L
      Next Feui
   Next N
End Sub

 

[bonoboas]

Re : Macro CTRL + F avec variable et export dans une feuille

Bonjour Danreb,
Merci beaucoup c'est parfait.
Cependant, j'aimerais rajouter la colonne I et J dans la sélection à copier à chaque fois. J'ai changé H pour J mais ça fait #N/A.
Pour info : les formules a copier :I4 =1 et J4 = SI(I4="";"";F4*1).
Est-ce qu'il est possible de changer aussi la sélection de =SOMMEPROD(...) en E3 et G3 en fonction des résultats trouvés. Mais bon, si c'est possible, sinon je le fais manuellement.

Merci encore Danreb c'est trop trop cool.

ps:est ce que vous pouvez mettre quelques commentaires sur le code s'il vous plaît pour mieux comprendre.

 

[Dranreb]

Re : Macro CTRL + F avec variable et export dans une feuille

Bonjour.
Il faut aussi remplacer les 8 par 10. Il y en a 2 si j'ai bien compté.
S'il faudra, par la suite, comprendre les commentaires en plus des instructions, ça ne va rien faciliter !
Vous feriez mieux de les mettre vous même ces commentaires, en me citant juste les instructions où vous ne savez quoi mettre du fait que vous ne les comprenez pas.

 

[bonoboas]

Re : Macro CTRL + F avec variable et export dans une feuille

Bonjour Danreb,

J'ai fait les changements comme annoncé mais ça bug sur la ligne Next C :

Private Sub Worksheet_Activate()
Dim T(), LstCr(), Ls As Long, ZCrit As String, N As Long, ET As Boolean, TCrit() As String, Feui As Worksheet, _
    L As Long, CEstOK As Boolean, Z As String, K As Long, TRés(1 To 2, 1 To 10), C As Long
 LstCr = FCrit.Range("A1:A" & FCrit.[A65536].End(xlUp).Row).Value
 Ls = -1
 Application.ScreenUpdating = False
 Me.Rows("6:65536").Delete
For N = 1 To UBound(LstCr)
    ZCrit = LstCr(N, 1)
    ET = InStr(ZCrit, ";") > 0: TCrit = Split(UCase(ZCrit), IIf(ET, ";", "*"))
    Ls = Ls + 2
    If Ls > 1 Then Me.Rows("1:3").Copy Destination:=Me.Rows(Ls)
    Me.Rows(Ls + 3).Resize(2).ClearContents
    Me.Cells(Ls, "B").Value = ZCrit
    Ls = Ls + 2
    For Each Feui In Worksheets
       If Feui.Index = Me.Index - 1 Then Exit For
       T = Feui.[M2:U2].Resize(Feui.UsedRange.Rows.Count - 1).Value
       For L = 1 To UBound(T)
          Z = UCase(T(L, 1))
          CEstOK = ET
          For K = 0 To UBound(TCrit)
             If Z Like "*" & TCrit(K) & "*" Then
                If Not ET Then CEstOK = True: Exit For
             ElseIf ET Then
                CEstOK = False: Exit For: End If
             Next K
          If CEstOK Then
             Ls = Ls + 1
             Me.[A4:J5].Copy Me.[A:J].Rows(Ls)
             TRés(1, 1) = T(L, 2): TRés(1, 2) = T(L, 3): For C = 3 To 10: TRés(1, C) = T(L, C + 1): Next C
             TRés(2, 2) = T(L, 1)
             Me.[A:J].Rows(Ls).Resize(2).Value2 = TRés: Me.Cells(Ls, "G").FormulaR1C1 = "=RC[-1]*RC[-2]"
             Ls = Ls + 1: End If
          Next L
       Next Feui
    Next N
End Sub

Cordialement

 

[Dranreb]

Re : Macro CTRL + F avec variable et export dans une feuille

Si c'est Indice en dehors de la plage mettez des espions pour examiner les valeur d'indices et voir ce qui est en dehors des limites.
Si c'est incompatibilité de type mettez On Error Resume Next devant pour que ça n'arrête pas l'exécution quand les données contiennent des valeurs qui ne peuvent pas être traitées.