Recherche sur plusieurs onglet avec recapitulatif sur nouvel onglet

[momo]

Bonjour à tous!!

J'ai un petit soucis pour mettre en place une formule de recherche sur plusieurs onglets

Le but du jeu c'est de faire un récap de tous les éléments des onglets Momo Lolo et May dont communs au fichier base et les envoyer sur l'onglet recap avec mention du nom de leur onglet d'origine

 

[adel53]

Re : Recherche sur plusieurs onglet avec recapitulatif sur nouvel onglet

Bonjour Momo

Ci-dessous un code répondant à ta demande

Sub test()
    With applicatin
        .ScreenUpdating = False
        .Calculation = xlManual
    End With
    Dim ws As Worksheet
    Dim derligne As Integer
    For Each ws In Worksheets
        If ws.Name <> "Recap" Then
            derligne = Sheets("Recap").Range("A" & Rows.Count).End(xlUp).Row + 1
            ws.Activate
            Range("A2").Select
            Range(Selection, Selection.End(xlDown)).Select
            Range(Selection, Selection.End(xlToRight)).Select
            Selection.Copy
            Sheets("Recap").Cells(derligne, 1).PasteSpecial Paste:=xlPasteValues
        End If
    Next ws
    With applicatin
        .ScreenUpdating = True
        .Calculation = xlAutomatic
    End With
    
End Sub

 

[job75]

Re : Recherche sur plusieurs onglet avec recapitulatif sur nouvel onglet

Bonjour momo,

A placer dans le code de la feuille "Recap" (clic droit sur l'onglet et Visualiser le code) :

Private Sub Worksheet_Activate()
Dim w As Worksheet
Application.ScreenUpdating = False
On Error Resume Next 'si aucune SpecialCells
Rows("2:" & Rows.Count).Delete 'RAZ de la feuille
For Each w In Worksheets
  If w.Name <> "Base" And w.Name <> Me.Name Then
    With w.[A1].CurrentRegion
      With .Offset(1).Resize(.Rows.Count - 1).Columns(4) 'colonne D auxiliaire
        .FormulaR1C1 = "=1/COUNTIF('Base'!C2,RC2)"
        .Value = .Value 'supprime les formules
        .SpecialCells(xlCellTypeConstants, 1).EntireRow.Copy _
          Cells(Rows.Count, 2).End(xlUp)(2, 0)
        .ClearContents 'RAZ de la colonne D
        [D:D].SpecialCells(xlCellTypeConstants, 1) = w.Name
      End With
    End With
  End If
Next
Columns.AutoFit 'ajustement largeur
End Sub

La macro s'exécute quand on active la feuille.

Mettre les en-têtes une fois pour toutes en A1 B1 C1 D1.

Edit : salut adel53, pas de Select en VBA grand Dieu !!!

A+

 

[momo]

Re : Recherche sur plusieurs onglet avec recapitulatif sur nouvel onglet

@ Adel53
J'ai d'abord essayé de mettre le code dans un module et là j'ai une erreur qui survient ( Le debobage souligne .ScreenUpdating = False)
Donc j'ai affecté la macro directement sur la page Recap et là c'est objet requis qui apparait je sais pas pourquoi

@Job75

La macro Fonctionne parfaitement c'est pile poile ce que j'espérait
Merci Beaucoup.
Par contre j'ai bien envie de comprendre et pas seulement copier coller

 

[momo]

Re : Recherche sur plusieurs onglet avec recapitulatif sur nouvel onglet

Salut Job75,
En Appliquant la macro sur ma feuille Originelle qui contient un peu plus de 3000 Lignes, elle a un peu de mal ( Elle rame beaucoup)
N'y aurait il pas un moyen de l'optimiser?

 

[job75]

Re : Recherche sur plusieurs onglet avec recapitulatif sur nouvel onglet

Re,

Ma macro précédente recherche la correspondance sur la seule colonne B.

Si l'on veut la correspondance sur les 3 colonnes A B C :

Private Sub Worksheet_Activate()
Dim w As Worksheet
Application.ScreenUpdating = False
On Error Resume Next 'si aucune SpecialCells
Rows("2:" & Rows.Count).Delete 'RAZ de la feuille
With Sheets("Base").[A1].CurrentRegion
  .Columns(1).Name = "Num"
  .Columns(2).Name = "Descrip"
  .Columns(3).Name = "Montant"
End With
For Each w In Worksheets
  If w.Name <> "Base" And w.Name <> Me.Name Then
    With w.[A1].CurrentRegion
      With .Offset(1).Resize(.Rows.Count - 1).Columns(4) 'colonne D auxiliaire
        .FormulaR1C1 = "=1/SUMPRODUCT((Num=RC1)*(Descrip=RC2)*(Montant=RC3))"
        .Value = .Value 'supprime les formules
        .SpecialCells(xlCellTypeConstants, 1).EntireRow.Copy _
          Cells(Rows.Count, 2).End(xlUp)(2, 0)
        .ClearContents 'RAZ de la colonne D
        [D:D].SpecialCells(xlCellTypeConstants, 1) = w.Name
      End With
    End With
  End If
Next
Columns.AutoFit 'ajustement largeur
End Sub

A+

 

[job75]

Re : Recherche sur plusieurs onglet avec recapitulatif sur nouvel onglet

Re,

En Appliquant la macro sur ma feuille Originelle qui contient un peu plus de 3000 Lignes, elle a un peu de mal ( Elle rame beaucoup)
N'y aurait il pas un moyen de l'optimiser?

1) La solution du post #6 sera encore moins rapide que celle du post #3.

Laquelle voulez-vous utiliser ?

2 ) Combien de feuilles à copier et combien de lignes dans chacune ?

3) Si vous avez des formules volatiles dans le classeur (avec DECALER par exemple), placez en début de macro :

Application.Calculation = xlCalculationManual

et en fin de macro :

Application.Calculation = xlCalculationAutomatic

A+

 

[momo]

Re : Recherche sur plusieurs onglet avec recapitulatif sur nouvel onglet

Job,

Vous avez très intelligemment anticipé la question que je m'apprêtais à vous poser
La deuxième méthode est celle que je veux utiliser (Correspondance sur les trois colonnes), la recherche pourra se faire sur jusqu'à 5 onglets

Ps: Pour la correspondance avec les onglets, les numeros en colonne A doivent être mêmes en tre la bases et les onglets auxiliaires; la description est parfois légerement différente et les montant peuvent etre différent ( Généralement sur les onglets il peut avoir plusieurs montants qui donnet le montant global présent dans la base)

 

[job75]

Re : Recherche sur plusieurs onglet avec recapitulatif sur nouvel onglet

Re,

Toujours avec la correspondance de 3 colonnes, voici une solution pas tableaux VBA :

Option Compare Text 'la casse est ignorée

Private Sub Worksheet_Activate()
Dim w As Worksheet, base, ub&, t, i&, x, y, z, j&, n&, rest()
base = Sheets("Base").[A1].CurrentRegion.Resize(, 3)
ub = UBound(base)
For Each w In Worksheets
  If w.Name <> "Base" And w.Name <> Me.Name Then
    t = w.[A1].CurrentRegion.Resize(, 3)
    For i = 2 To UBound(t)
      x = t(i, 1): y = t(i, 2): z = t(i, 3)
      For j = 2 To ub
        If base(j, 1) = x And base(j, 2) = y And base(j, 3) = z Then
          n = n + 1
          ReDim Preserve rest(1 To 4, 1 To n)
          rest(1, n) = x: rest(2, n) = y: rest(3, n) = z
          rest(4, n) = w.Name
          Exit For
        End If
      Next j
    Next i
  End If
Next w
If n Then [A2].Resize(n, 4) = Application.Transpose(rest)
Rows(n + 2 & ":" & Rows.Count).Delete
Columns.AutoFit 'ajustement largeur
End Sub

Le tableau rest est restitué d'un seul coup dans la feuille.

Il n'y a pas plus rapide que cette solution.

A+

 

[job75]

Re : Recherche sur plusieurs onglet avec recapitulatif sur nouvel onglet

Re,

Pour que la casse soit ignorée (en colonne B) ajouter en haut de la feuille de code :

Option Compare Text 'la casse est ignorée

A+

 

[momo]

Re : Recherche sur plusieurs onglet avec recapitulatif sur nouvel onglet

Ok parfait, en le testant sauf erreur, j'ai remarqué qu'il ne ressort que seuls des éléments100% identiques alors que dans un des onglets le montant global dans la base peut être splité en plusieurs petits montants avec une description légerement différente mais la colonne num sera identique à tous les coups entre tous les onglets

 

[job75]

Re : Recherche sur plusieurs onglet avec recapitulatif sur nouvel onglet

Re,

avec une description légerement différente

Excel ne sait pas ce que veut dire "légèrement", et moi non plus.

Bonne nuit.

 

[momo]

Re : Recherche sur plusieurs onglet avec recapitulatif sur nouvel onglet

Bonjour Job, bonjour à Tous

je reviens ce matin avec le même probleme mais ma feuille recap se presente differement pour une meilleur lecture des éléments en communs

Je vous mets le fichier en pièces jointes avec les infos telles que la macro devrait les traiter en feuille recap 2

 

[job75]

Re : Recherche sur plusieurs onglet avec recapitulatif sur nouvel onglet

Bonjour momo,

Ce n'est probablement pas impossible à obtenir si l'on aime les usines à gaz, mais là je vous abandonne.

A+

 

[momo]

Re : Recherche sur plusieurs onglet avec recapitulatif sur nouvel onglet

Ok Merci beaucoup Job pour votre aide qui m'a été très précieuse!!!!