Microsoft 365 Récupérer la data de plusieurs feuille

[driss Kor]

Bonjour

Je souhaite avec le VBA sur le fichier ci-joint récupérer le % Rate et paie en vérifiant chaque feuille avec comme critère de recherche le ID

D'avance Merci pour votre aide.

 

[sylvanu]

Bonjour Driss,
Il est où le ficher joint ? 🙂

 

[job75]

Bonjour driss Kor, sylvanu,

Voyez le fichier joint et cette fonction VBA :

Function TrouveValeur(lig, ref As Range)
Application.Volatile
Dim w As Worksheet, c As Range
On Error Resume Next
Set w = Sheets(lig)
Set c = w.Cells.Find(ref, , xlValues)
TrouveValeur = ""
TrouveValeur = c.Offset(, 1)
End Function

Formule en Feuil1!A4 à tirer à droite et vers le bas : =TrouveValeur(LIGNE()-2;A$3)

Edit : pas besoin des variables w et c :

Function TrouveValeur(lig, ref As Range)
Application.Volatile
On Error Resume Next
TrouveValeur = ""
TrouveValeur = Sheets(lig).Cells.Find(ref, , xlValues).Offset(, 1)
End Function

A+

 

[sylvanu]

Re, bonjour Job,
Dans le même ordre d'idée, un essai en PJ sans formule.
La table se remet à jour automatiquement lorsqu'on sélectionne la feuille Feuil1. Avec :

Sub Worksheet_Activate()
Dim L%, F
L = 4: [A4:C30].ClearContents
For Each F In Worksheets
    If F.Name <> ActiveSheet.Name Then
        On Error Resume Next
        Cells(L, "A") = Sheets(F.Name).Cells.Find("ID", , xlValues).Offset(, 1)
        Cells(L, "B") = Sheets(F.Name).Cells.Find("% Rate", , xlValues).Offset(, 1)
        Cells(L, "C") = Sheets(F.Name).Cells.Find("Paie", , xlValues).Offset(, 1)
        L = L + 1
    End If
Next F
End Sub

 

[job75]

Ma solution du post #3 est quand même très minimaliste.

Cette fonction va bien quelles que soient les positions des feuilles et seules celles contenant "ID" sont étudiées :

Function TrouveValeur(lig&, ref As Range)
Application.Volatile
Dim nomfeuille$, w As Worksheet, c As Range, n&, nf$
nomfeuille = Application.Caller.Parent.Name
For Each w In Worksheets
    If w.Name <> nomfeuille Then
        Set c = w.Cells.Find("ID", , xlValues, xlWhole)
        If Not c Is Nothing Then n = n + 1: If n = lig Then nf = w.Name: Exit For
    End If
Next
On Error Resume Next
TrouveValeur = ""
TrouveValeur = Sheets(nf).Cells.Find(ref, , xlValues, xlWhole).Offset(, 1)
End Function

 

[sylvanu]

Bonsoir Job,
Le souci d'une telle fonction est que si l'utilisateur change la feuille de place ou en ajoute une avant alors les résultats sont incorrectes.
De plus à chaque modification de valeur dans une quelconque fois tout le tableau sera réactualisé.
Deux soucis qu'on évite avec un Worksheet_Activate.

 

[job75]

Le souci d'une telle fonction est que si l'utilisateur change la feuille de place ou en ajoute une avant alors les résultats sont incorrectes.

Pas du tout, avec la fonction du post #5 aucun problème, j'ai bien dit "quelles que soient les positions des feuilles".

De plus à chaque modification de valeur dans une quelconque fois tout le tableau sera réactualisé.

Heureusement !