Hà muitas coisas que pode ser feitas para agilizar um código.
Para sabermos qual sugerir, precisamos ver o código, e todas as macros que podem estar concorrendo...

Por favor coloque um exemplo do arquivo lento...

Abs

Olá Fernando,

Curiosamente o código é seu. Foi uma outra dúvida que você mandou o código. Inicialmente não estava funcionando porque, a coluna onde a macro utilizava para nomear os arquivos devia ter algum caractere que travava o código. Então o Reinaldo alterou e resolveu o caso. Se executado isoladamente, funciona rapidamente. Acontece que ele foi inserido em outra planilha, aí é uma lentidão para importar os *.txts.

Sub AleVBA_19511()
Dim rCell As Range
Dim FF As Long, Counter As Long
Counter = 1
    For Each rCell In Range("A1", Range("A" & Rows.Count).End(xlUp))
        If rCell.Value <> "" And Range("A" & rCell.Row).Value <> "" Then
            FF = FreeFile()
            '                Aqui o arquivo pega o nome das células col A
            Open ThisWorkbook.Path & "" & Counter & ".txt" For Output As #FF
            Print #FF, rCell.Text
            Close #FF
            Counter = Counter + 1
        End If
    Next rCell
    
    MsgBox Counter & " Arquivos salvos. ", , "Criar Arquivo de Texto"
    
End Sub

.

Pode verificar ?.

Obrigado.

Oi Luiz, vou dar uma olhadinha, mas já adianto: esse código não é meu não.
Eu percebo pela padronização de declaração de variáveis, uso dos objetos e tal.
Posso até eventualmente ter mexido no código do AleVBA *(que nomeia seus códigos com o nome dele), mas esse código claramente não foi escrito por mim não.

Sub AleVBA_19511_EditadoPorFernandoFernandes()
Dim Pasta   As String
Dim Matriz  As Variant
Dim FF      As Long
Dim Counter As Long
    
    Pasta = ThisWorkbook.Path
    Matriz = Range("A1", Range("A" & Rows.Count).End(xlUp)).Value
    For Counter = LBound(Matriz, 1) To UBound(Matriz, 1)
        If Matriz(Counter, 1) <> vbNullString Then
            FF = FreeFile()
'Aqui o arquivo pega o nome das células col A
            Open Pasta & "" & Counter & ".txt" For Output As #FF
            Print #FF, VBA.CStr(Matriz(Counter, 1))
            Close #FF
            Counter = Counter + 1
        End If
        
    Next Counter
    
    MsgBox Counter & " Arquivos salvos. ", , "Criar Arquivo de Texto"
    
End Sub

Isso que eu fiz, acredito que vai melhorar muito o desempenho.
Dá uma conferida, trabalhei com matrizes.

Olá Fernando,

Cara, mil desculpas. Eu fiz uma confusão aqui. Sem desmerecer nem um nem outro. Realmente o código foi postado pelo Axeandre VBA.
Vou fazer uns testes e retorno.

Valeu.

Fernando,

Já arrumei aqui as informações. Seguinte, o código é seu. Não o código que postei, mas outro código que não foi postado.
O código para a ajuda neste tópico é o seguinte;

Public Sub ImportarArqText)

    Dim NomeArquivo As String
    Dim Caminho As String
        
    Dim wshContratos As Worksheet
    Dim rngCell As Range
    Dim rngMyArquivos As Range
    Dim celDestino
    
    'definimos o nome da aba
    Set wshContratos = Worksheets("Contratos")
    
    'Definimos o Range com Dados até a ultima linha preenchida
    Set rngMyArquivos = wshContratos.Range("c2:c" & Range("c" & Rows.Count).End(xlUp).Row)
       
    'Definimos o caminho no mesmo local do arquivo Controle.xls
    Caminho = ActiveWorkbook.Path & ""
    
    'Loop em cada celula no Range
    For Each rngCell In rngMyArquivos
        
        'Definimos a celula para inserir o texto
        celDestino = rngCell.Offset(0, 2).Address(0, 0)
        
        'Nome de cada arquivo
        NomeArquivo = rngCell & ".txt"

        If VBA.CreateObject("Scripting.FileSystemObject").FileExists(Caminho & NomeArquivo) Then

             
        'Abre o arquivo para leitura
            Open Caminho & NomeArquivo For Input As #1
            
            'Inseri o conteudo do arquivo na celula correspondente ao arquivo
            Range(celDestino).Value = Input$(LOF(1), 1)
            
            'Fecha o arquivo Texto
            Close #1
        Else
            Msgbox "Arquivo não Encontrado"
        End If            
    Next rngCell
        
    ActiveSheet.Range("A:O").Columns.AutoFit
       
End Sub

.

Houve sim uma pequena adaptação como falei por outro colega, Trindade.

A falha continua sendo minha, e peço desculpas pela bagunça.

Parece que falta um parentese na primeira linha?
Pelo que vejo no código, minha única contribuição foi esse linha:

If VBA.CreateObject("Scripting.FileSystemObject").FileExists(Caminho & NomeArquivo) Then

é a única que parece ter sido eu que escrevi ...
E pelo que li, o objetivo é ler um txt e colocar seu conteúdo na célula duas colunas ao lado...
isso vou demorar um pouco mais pra fazer...

Vai ter que esperar...

Olá Fernando,

Ainda estou contando com a sua ajuda no código. Para não haver dúvidas, estou postando o código que utilizo atualmente. A questão é que, o conteúdo importado é base de pesquisa para algumas fórmulas, imagino que durante o cálculo, a macro leve mais tempo para processar. Então a idéia é isolar a macro até sua conclusão. Nem sei se isso é possível. Em todo caso, estou no aguardo.

Public Sub Importar()

    Dim NomeArquivo As String
    Dim Caminho As String
        
    Dim wshContratos As Worksheet
    Dim rngCell As Range
    Dim rngMyArquivos As Range
    Dim celDestino
    
      
    'definimos o nome da aba
    Set wshContratos = Worksheets("Contratos")
    
    'Definimos o Range com Dados até a ultima linha preenchida
    Set rngMyArquivos = wshContratos.Range("c2:c" & Range("c" & Rows.Count).End(xlUp).Row)
       
    'Definimos o caminho no mesmo local do arquivo Controle.xls
    Caminho = ActiveWorkbook.Path & ""
    
    'Loop em cada celula no Range
    For Each rngCell In rngMyArquivos
        
        'Definimos a celula para inserir o texto
        celDestino = rngCell.Offset(0, 1).Address(0, 0)
        
        'Nome de cada arquivo
        NomeArquivo = rngCell & ".txt"

        If VBA.CreateObject("Scripting.FileSystemObject").FileExists(Caminho & NomeArquivo) Then

             
        'Abre o arquivo para leitura
            Open Caminho & NomeArquivo For Input As #1
         
            'Inseri o conteudo do arquivo na celula correspondente ao arquivo
            Range(celDestino).Value = Input$(LOF(1), 1)
         
            'Fecha o arquivo Texto
            Close #1
        Else
            MsgBox "Arquivo não Encontrado  " _
            & rngCell
        End If
    Next rngCell
        
    ActiveSheet.Range("A:O").Columns.AutoFit
MsgBox "Importação Concluída !!!"
End Sub

Obrigado.

Coloque a planilha em codigo manual no incio do codigo e mude para automatico no final.

Talvez resolva.