Sub Worksheet_Activate()
Dim F, NbLigNoms%, NbLigDates%, Nom%, Dat%, Ligne%
Set F = Sheets("Feuil1")
[A:B].ClearContents: [A1] = "Nom": [B1] = "Date"
Application.ScreenUpdating = False
NbLigNoms = F.[Tableau2].ListObject.ListRows.Count ' Nb ligne TDS
NbLigDates = F.[Tableau3].ListObject.ListRows.Count ' Nb ligne TDS
Ligne = 2
For Nom = 1 To NbLigNoms
For Dat = 1 To NbLigDates
Cells(Ligne, "A") = [Tableau2[nom]].Item(Nom)
' Récupère la ligne date
Lignetablo = Application.Match([Tableau3[dates]].Item(Dat), F.[C:C], 0)
' Colle la formule =Feuil1!Cxx avec xx la bonne ligne
Cells(Ligne, "B").Formula = "=Feuil1!C" & Lignetablo
' Récupère la ligne nom
Lignetablo = Application.Match([Tableau2[nom]].Item(Nom), F.[A:A], 0)
' Colle la formule =Feuil1!Axx avec xx la bonne ligne
Cells(Ligne, "A").Formula = "=Feuil1!A" & Lignetablo
Ligne = Ligne + 1
Next Dat
Next Nom
Application.ScreenUpdating = True
End Sub