Remplacer le nom d'une feuille par une cellule
Bonjour à tous,
Tout est dans le titre.
Voici ma formule :
=RECHERCHEV("Heures productives";'C:\Users\stage\Desktop\Travaux\AIS\[FICHIER AC CS 2014 12.xls]CONSO hors MC'!$C$11:$J$40;8;0)
Et j'aimerais remplacer
CONSO hors MC'
par la valeur qui se trouve en E4
Merci d'avance de votre aide.
Cordialement
Freeman
Ce n'est pas possible...
Par contre il existe une fonction personnalisée qui exige d'utiliser les referances DAO qui pourrait te servir..
C'est la fonction Xrecherchev et on l'utilise comme ça:
=XRECHERCHEV(A2;"'C:\Perso\[" & D2 & "]_Synthèse'!$A$2:$F$35";6)
Public Function XRECHERCHEV(ByVal valRecherchee As Variant, _
ByVal TabMatrice As Variant, _
ByVal colonneIndex As Integer)
If TypeName(TabMatrice) = "Range" Then
XRECHERCHEV = Application.WorksheetFunction.VLookup(valRecherchee, _
TabMatrice, _
colonneIndex, _
True)
Else
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim sRange As String
Dim sSheet As String
Dim sWbook As String
Dim sFPath As String
Dim sSQL As String
sRange = Replace(Split(TabMatrice, "!")(1), "$", vbNullString)
sSheet = Split(Split(TabMatrice, "]")(1), "'")(0)
sWbook = Split(Split(TabMatrice, "[")(1), "]")(0)
sFPath = Mid(Split(TabMatrice, "[")(0), 2)
valRecherchee = "'" & Replace(valRecherchee, "'", "''") & "'"
sSQL = "SELECT [F" & colonneIndex & "] " & _
"FROM [" & sSheet & "$" & sRange & "] " & _
"WHERE [F1] = " & valRecherchee
Set db = DAO.OpenDatabase(sFPath & sWbook, False, False, "Excel 8.0;HDR=NO;")
Set rs = db.OpenRecordset(sSQL, DAO.dbOpenSnapshot)
If rs.EOF And rs.BOF Then
XRECHERCHEV = "no match"
Else
XRECHERCHEV = rs.Fields(0)
End If
Set rs = Nothing
Set db = Nothing
End If
End Function
Bonjour. bienvenue sur le Forum
Si tu n'utilise ce fichier que sur ton PC, tu peux utiser la macro complémentaire Morefunc de Laurent Longres après l'avoir téléchargée.(Dans ton navigateur, tu tapes Morefunc...)
Pour la rendre opérationnelle (trouvé sur un autre Forum)
1/ ouvrir fichier excel
2/ fichier
3/ option excel
4/ complément
5/ voir si l'onglet gérer et bien sur ( complément excel )
6/ choisir un complément d'application actif (n'importe lequel )
7/ appuyer sur " atteindre "
8/ dans la fenêtre macro complémentaire faire " parcourir "
9/ là tu cherche le fichier " Morefunc " en principe dans =>C:/progame files/Morefunc
- tu dois voir 3 macros complémentaire
- tu choisis en premier la macro nommé "Morefunc" => OK => elle doit apparaître maintenant dans la fenêtre => OK
Ta formule devient
=RECHERCHEV("Heures productives";INDIRECT.EXT("'C:\Users\stage\Desktop\Travaux\AIS\[FICHIER AC CS 2014 12.xls]"&E4&"'!$C$11:$J$40");8;0)
Cordialement
Bonsoir, merci je vais tester tout ça lundi et je vous tiendrais au courant.
Merci en tout cas pour votre temps
Cordialement
EngueEngue a écrit :Ce n'est pas possible...
Par contre il existe une fonction personnalisée qui exige d'utiliser les referances DAO qui pourrait te servir..
C'est la fonction Xrecherchev et on l'utilise comme ça:
=XRECHERCHEV(A2;"'C:\Perso\[" & D2 & "]_Synthèse'!$A$2:$F$35";6)
Public Function XRECHERCHEV(ByVal valRecherchee As Variant, _ ByVal TabMatrice As Variant, _ ByVal colonneIndex As Integer) If TypeName(TabMatrice) = "Range" Then XRECHERCHEV = Application.WorksheetFunction.VLookup(valRecherchee, _ TabMatrice, _ colonneIndex, _ True) Else Dim db As DAO.Database Dim rs As DAO.Recordset Dim sRange As String Dim sSheet As String Dim sWbook As String Dim sFPath As String Dim sSQL As String sRange = Replace(Split(TabMatrice, "!")(1), "$", vbNullString) sSheet = Split(Split(TabMatrice, "]")(1), "'")(0) sWbook = Split(Split(TabMatrice, "[")(1), "]")(0) sFPath = Mid(Split(TabMatrice, "[")(0), 2) valRecherchee = "'" & Replace(valRecherchee, "'", "''") & "'" sSQL = "SELECT [F" & colonneIndex & "] " & _ "FROM [" & sSheet & "$" & sRange & "] " & _ "WHERE [F1] = " & valRecherchee Set db = DAO.OpenDatabase(sFPath & sWbook, False, False, "Excel 8.0;HDR=NO;") Set rs = db.OpenRecordset(sSQL, DAO.dbOpenSnapshot) If rs.EOF And rs.BOF Then XRECHERCHEV = "no match" Else XRECHERCHEV = rs.Fields(0) End If Set rs = Nothing Set db = Nothing End If End Function
Merci à toi j'ai utilisé cette fonction qui me semblait la meilleure dans mon cas.
Cordialement.