Insertion conditionnelle d'un .txt dans une cellule

Bonjour,

J'ai un fichier excel avec une liste de valeurs dans la colonne A.
Ces valeurs correspondent à des noms de fichiers texte (sans le .txt) stockés dans un même dossier.
Je voudrais créer une macro qui parcours la colonne A et qui pour une valeur en Ai va chercher le contenu du fichier texte dons le nom correspond à la valeur et insère l'ensemble de son contenu dans la cellule Bi.
Pour l'instant j'ai trouvé une macro qui insère en B1 le contenu d'un fichier texte que l'on sélectionne à l'ouverture d'une fenêtre:

Sub LireFichierTexte()
Dim Texte As String
Dim Ligne As String
Dim Index As Integer
Dim Chemin
On Error GoTo LigneErreur
Chemin = Application.GetOpenFilename("Fichiers texte (*.txt), *.txt")
If Chemin <> False Then
Index = FreeFile
Open Chemin For Input As #Index
Do While Not EOF(Index)
Line Input #Index, Ligne
If Texte = "" Then
Texte = Ligne
Else
Texte = Texte & vbCrLf & Ligne
End If
Loop
Close #Index
[Bi] = Texte
End If
Exit Sub
LigneErreur:
MsgBox "Erreur !"
End Sub

Au final je voudrais une macro qui ne nécessite pas une sélection de fichier via une fenêtre, mais plutôt quelque chose d'automatique.

Je vous remercie pour votre aide :)