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