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.