Olá gente boa!
Sou novato por aqui e também em programação em VBA.
Gostaria muito de contar com a ajuda dos senhores(as)!

Estou precisando de um código que ao clicar em um determinado botão (serão 30 no total), abra a opção para realizar a importação de uma outra planilha que estará na minha rede (é importante que o arquivo seja selecionado de qualquer diretório).
Essa planilha que será importada terá um padrão definido (por exemplo, a célula A1 terá o mesmo nome do botão, esse dado deverá ser checado, e os dados a serem copiados estarão na range "A6:S56" da sheet com mesmo nome). Tudo em valores (texto e números).

Ao terminar a importação, seria importante retornar uma mensagem (sucesso ou falha caso não seja a planilha padrão) e também ter um "ok" ao lado do botão.

Até a parte de selecionar a planilha a ser importada eu consegui fazer (contando com a ajuda aqui do fórum em tópicos parecidos), depois disso faltou conhecimento.

Usei esse código para abrir a caixa e tentei ligar com um outro para copiar... não deu certo.

Sub Import()
Dim File As String
Dim FileToOpen
FileToOpen = Application.GetOpenFilename _
(Title:="Selecione o arquivo a ser importado", _
FileFilter:="Text Files *.xlsx (*.xlsx),")
File = FileToOpen
If FileToOpen = False Then
MsgBox "Você clicou em cancelar. Especifique um Arquivo.", vbExclamation
Exit Sub
Else: ImpTextFile FName:=File, Sep:="|"
End If
End Sub
 
 
 
Esse outro seria o código para copiar... furado! Aqui eu fui misturando tudo...

Function ImpTextFile(FName As String, Sep As String)
 
Dim RowNdx As Long
Dim ColNdx As Integer
Dim TempVal As Variant
Dim WholeLine As String
Dim Pos As Integer
Dim NextPos As Integer
Dim SaveColNdx As Integer

D1_.Activate
Range("A1:S57").ClearContents
D1_.Cells(1, 1).Select
 
Application.ScreenUpdating = False
 
On Error GoTo EndMacro:
SaveColNdx = ActiveCell.Column
RowNdx = ActiveCell.Row
 
Open FName For Input Access Read As #1
 
While Not EOF(1)
    Line Input #1, WholeLine
    If Right(WholeLine, 1) <> Sep Then
        WholeLine = WholeLine & Sep
    End If
    ColNdx = SaveColNdx
    Pos = 1
    NextPos = InStr(Pos, WholeLine, Sep)
    While NextPos >= 1
        TempVal = Mid(WholeLine, Pos, NextPos - Pos)
        Cells(RowNdx, ColNdx).Value = TempVal
        Pos = NextPos + 1
        ColNdx = ColNdx + 1
        NextPos = InStr(Pos, WholeLine, Sep)
    Wend
    RowNdx = RowNdx + 1
Wend
EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #1
End Function

Alguém consegue me salvar?