Macro copiar y pegar ruta de carpeta en celda

Hola buen dia...
Tengo una macro que me deja elegir una carpeta y me muestra su ruta en un MsgBox, pero tambien necesito que copie esa ruta y me la pegue en una celda.
Es algo sencillo pero se me ha dificultado un poco
Este es el codigo
Private Type BROWSEINFO ' used by the function GetFolderName
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
    Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
    Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Function GetFolderName(Msg As String) As String
' returns the name of the folder selected by the user
Dim bInfo As BROWSEINFO, path As String, r As Long
Dim X As Long, pos As Integer
    bInfo.pidlRoot = 0& ' Root folder = Desktop
    If IsMissing(Msg) Then
        bInfo.lpszTitle = "Selecciona una carpeta"
        ' the dialog title
    Else
        bInfo.lpszTitle = Msg ' the dialog title
    End If
    bInfo.ulFlags = &H1 ' Type of directory to return
    X = SHBrowseForFolder(bInfo) ' display the dialog
    ' Parse the result
    path = Space$(512)
    r = SHGetPathFromIDList(ByVal X, ByVal path)
    If r Then
        pos = InStr(path, Chr$(0))
        GetFolderName = Left(path, pos - 1)
    Else
        GetFolderName = ""
    End If
End Function
Sub TestGetFolderName()
Dim FolderName As String
    FolderName = GetFolderName("Selecciona una carpeta")
    If FolderName = "" Then
        MsgBox "No has selecionado ninguna carpeta"
    Else
        MsgBox "Haz seleccionado la carpeta: " & FolderName
    End If
End Sub
Saludos y Muchas Gracias