Note: The other languages of the website are Google-translated. Back to English

Como importar vários arquivos de texto de uma pasta para uma planilha?

Por exemplo, aqui você tem uma pasta com vários arquivos de texto, o que você deseja fazer é importar esses arquivos de texto para uma única planilha, como mostra a captura de tela abaixo. Em vez de copiar os arquivos de texto um por um, há algum truque para importar rapidamente os arquivos de texto de uma pasta para uma folha?

Importe vários arquivos de texto de uma pasta em uma única folha com VBA

Importe o arquivo de texto para a célula ativa com o Kutools para Excel boa ideia 3


Aqui está um código VBA que pode ajudá-lo a importar todos os arquivos de texto de uma pasta específica para uma nova planilha.

1. Habilite uma pasta de trabalho para a qual deseja importar arquivos de texto e pressione Alt + F11 chaves para habilitar Microsoft Visual Basic para Aplicações janela.

2. Clique inserção > Módulo, copie e cole abaixo o código VBA no Módulo janela.

VBA: Importar vários arquivos de texto de uma pasta para uma folha

Sub Test()
'UpdatebyExtendoffice6/7/2016
    Dim xWb As Workbook
    Dim xToBook As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    Dim xFiles As New Collection
    Dim I As Long
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder [Kutools for Excel]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
    xFile = Dir(xStrPath & "*.txt")
    If xFile = "" Then
        MsgBox "No files found", vbInformation, "Kutools for Excel"
        Exit Sub
    End If
    Do While xFile <> ""
        xFiles.Add xFile, xFile
        xFile = Dir()
    Loop
    Set xToBook = ThisWorkbook
    If xFiles.Count > 0 Then
        For I = 1 To xFiles.Count
            Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
            xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)
            On Error Resume Next
            ActiveSheet.Name = xWb.Name
            On Error GoTo 0
            xWb.Close False
        Next
    End If
End Sub

3. Pressione F5 para exibir uma caixa de diálogo e selecionar uma pasta que contém os arquivos de texto que deseja importar. Veja a imagem:
doc importar arquivos de texto de uma pasta 1

4. Clique OK. Em seguida, os arquivos de texto foram importados para a pasta de trabalho ativa como uma nova planilha separadamente.
doc importar arquivos de texto de uma pasta 2


Se você deseja importar um arquivo de texto para uma célula ou intervalo específico, você pode aplicar Kutools for Excel'S Inserir arquivo no cursor utilidade.

Kutools for Excel, com mais de 300 funções úteis, tornam seus trabalhos mais fáceis. 

Depois de instalação grátis Kutools para Excel, faça o seguinte:

1. Selecione a célula para a qual deseja importar o arquivo de texto e clique em Kutools Plus > Importação / Exportação > Inserir arquivo no cursor. Veja a imagem:
doc importar arquivos de texto de uma pasta 3

2. Em seguida, uma caixa de diálogo aparecerá, clique em Procurar para exibir o Selecione um arquivo a ser inserido na caixa de diálogo de posição do cursor da célula, em seguida selecione Arquivos de texto na lista suspensa e escolha o arquivo de texto que deseja importar. Veja a imagem:
doc importar arquivos de texto de uma pasta 4

3. Clique Abre > Ok, e o arquivo de texto especificado foi inserido na posição do cursor, veja a captura de tela:
doc importar arquivos de texto de uma pasta 5


As melhores ferramentas de produtividade para escritório

O Kutools for Excel resolve a maioria dos seus problemas e aumenta sua produtividade em 80%

  • armadilha para peixes: Insira rapidamente fórmulas complexas, gráficos e qualquer coisa que você tenha usado antes; Criptografar células com senha; Criar lista de discussão e enviar emails ...
  • Barra Super Fórmula (edite facilmente várias linhas de texto e fórmula); Layout de leitura (ler e editar facilmente um grande número de células); Colar na faixa filtrada...
  • Mesclar células / linhas / colunas sem perder dados; Dividir o conteúdo das células; Combinar linhas / colunas duplicadas... Evite células duplicadas; Comparar intervalos...
  • Selecione Duplicado ou Único Linhas; Selecione linhas em branco (todas as células estão vazias); Super Find e Fuzzy Find em muitos livros; Seleção aleatória ...
  • Cópia exata Várias células sem alterar a referência da fórmula; Criação automática de referências para várias folhas; Inserir marcadores, Caixas de seleção e mais ...
  • Extrair Texto, Adicionar texto, remover por posição, Remover Espaço; Criar e imprimir subtotais de paginação; Converter entre conteúdo de células e comentários...
  • Super Filtro (salvar e aplicar esquemas de filtro a outras planilhas); Classificação Avançada por mês / semana / dia, frequência e mais; Filtro Especial por negrito, itálico ...
  • Combine pastas de trabalho e planilhas; Mesclar tabelas com base em colunas-chave; Divida os dados em várias folhas; Conversão em lote de xls, xlsx e PDF...
  • Mais de 300 recursos poderosos. Suporta Office / Excel 2007-2021 e 365. Suporta todos os idiomas. Fácil implantação em sua empresa ou organização. Recursos completos de avaliação gratuita de 30 dias. Garantia de devolução do dinheiro em 60 dias.
guia kte 201905

Guia do Office traz interface com guias para o Office e torna seu trabalho muito mais fácil

  • Habilite a edição e leitura com guias em Word, Excel, PowerPoint, Publisher, Access, Visio e Project.
  • Abra e crie vários documentos em novas guias da mesma janela, em vez de em novas janelas.
  • Aumenta sua produtividade em 50% e reduz centenas de cliques do mouse para você todos os dias!
parte inferior da aba do escritório
Comentários (46)
Avaliado 4 fora do 5 · classificações 1
Este comentário foi feito pelo moderador no site
Sub Test ()
'Atualizar porExtendoffice6/7/2016
Dim xWb como pasta de trabalho
Dim xToBook como pasta de trabalho
Dim xStrPath como String
Dim xFileDialog como FileDialog
Dim xArquivo como String
Dim xFiles como nova coleção
Escurecer eu enquanto
Definir xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = Falso
xFileDialog.Title = "Selecione uma pasta [Kutools for Excel]"
Se xFileDialog.Show = -1 Então
xStrPath = xFileDialog.SelectedItems(1)
Se acabar
If xStrPath = "" Então Exit Sub
If Right(xStrPath, 1) <> "\" Então xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
Se xArquivo = "" Então
MsgBox "Nenhum arquivo encontrado", vbInformation, "Kutools for Excel"
Exit Sub
Se acabar
Faça While xFile <> ""
xFiles. Adicionar xFile, xFile
xArquivo = Dir()
laço
Definir xToBook = ThisWorkbook
Se xFiles.Count > 0 Então
Para I = 1 Para xFiles.Count
Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
xWb.Worksheets(1).Copiar após:=xToBook.Sheets(xToBook.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = xWb.Name
Em erro GoTo 0
xWb.Fechar Falso
Seguinte
Se acabar
End Sub

este código está ajudando, mas eu quero

tab, ponto e vírgula, espaço true como fazer isso por favor me ajude
Este comentário foi feito pelo moderador no site
Deseja manter o espaço (delimitadores) após converter os arquivos de texto em planilhas?
Este comentário foi feito pelo moderador no site
esse é o meu problema também, este código é verdadeiro. mas depois de converter arquivos de texto para excel, ele não mantém os delimitadores.
Este comentário foi feito pelo moderador no site
Você poderia fazer o upload do arquivo de texto e o resultado que deseja para mim?
Este comentário foi feito pelo moderador no site
Eu tenho o mesmo problema. Os arquivos txt estão todos em planilhas separadas e o código ignora o espaço entre as duas colunas
Este comentário foi feito pelo moderador no site
Olá, Des e PB Rama Murty, o código abaixo pode dividir dados em colunas com base em espaço ou tabulação ao importar arquivo de texto para planilhas. Você pode tentar.

Sub ImportarTextoParaExcel()
'Atualizar porExtendoffice20180911
Dim xWb como pasta de trabalho
Dim xToBook como pasta de trabalho
Dim xStrPath como String
Dim xFileDialog como FileDialog
Dim xArquivo como String
Dim xFiles como nova coleção
Escurecer eu enquanto
Dim xIntRow por muito tempo
Dim xFNum, xFArr Enquanto
Dim xStrValue como String
Dim xRg como intervalo
Dim xArr
Definir xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = Falso
xFileDialog.Title = "Selecione uma pasta [Kutools for Excel]"
Se xFileDialog.Show = -1 Então
xStrPath = xFileDialog.SelectedItems(1)
Se acabar
If xStrPath = "" Então Exit Sub
If Right(xStrPath, 1) <> "\" Então xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
Se xArquivo = "" Então
MsgBox "Nenhum arquivo encontrado", vbInformation, "Kutools for Excel"
Exit Sub
Se acabar
Faça While xFile <> ""
xFiles. Adicionar xFile, xFile
xArquivo = Dir()
laço
Definir xToBook = ThisWorkbook
On Error Resume Next
Application.ScreenUpdating = False
Se xFiles.Count > 0 Então

Para I = 1 Para xFiles.Count
Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
xWb.Worksheets(1).Copiar após:=xToBook.Sheets(xToBook.Sheets.Count)

ActiveSheet.Name = xWb.Name

xWb.Fechar Falso
xIntRow = ActiveCell.CurrentRegion.Rows.Count
Para xFNum = 1 Para xIntRow
Set xRg = ActiveSheet.Range("A" & xFNum)
xArr = Split(xRg.Text, " ")
Se UBound(xArr) > 0 Então
Para xFArr = 0 Para UBound(xArr)
Se xArr(xFArr) <> "" Então
xRg.Value = xArr(xFArr)
Definir xRg = xRg.Offset(ColumnOffset:=1)
Se acabar
Seguinte
Se acabar
Seguinte
Seguinte
Se acabar
Application.ScreenUpdating = True
End Sub
Este comentário foi feito pelo moderador no site
Quais alterações são necessárias se você quiser dividir os dados em colunas com base em vírgula
Este comentário foi feito pelo moderador no site
Quais alterações precisam ser feitas se eu precisar de dados em colunas com base em vírgula?
Este comentário foi feito pelo moderador no site
Eu usei isso e funciona, mas gostaria que tudo fosse salvo em uma planilha, pois cada planilha contém as mesmas informações, são apenas arquivos de log de cada dia.
então eu preciso combinar o
todos os itens da pasta em uma folha
Sub ImportaçãoCSVsWithReference()
'UpdatebyKutoolsforExcel20151214
Dim xWb como pasta de trabalho
Dim xToBook como pasta de trabalho
Dim xStrPath como String
Dim xFileDialog como FileDialog
Dim xArquivo como String
Dim xFiles como nova coleção
Escurecer eu enquanto
Dim xIntRow por muito tempo
Dim xFNum, xFArr Enquanto
Dim xStrValue como String
Dim xRg como intervalo
Dim xArr
Em caso de erro Ir para ErrHandler
Definir xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = Falso
xFileDialog.Title = "Selecione uma pasta [Kutools for Excel]"
Se xFileDialog.Show = -1 Então
xStrPath = xFileDialog.SelectedItems(1)
Se acabar
If xStrPath = "" Então Exit Sub
If Right(xStrPath, 1) <> "\" Então xStrPath = xStrPath & "\"
Definir xSht = ThisWorkbook.ActiveSheet
If MsgBox("Limpar a planilha existente antes de importar?", vbYesNo, "Kutools for Excel") = vbYes Then xSht.UsedRange.Clear
Application.ScreenUpdating = False
xFile = Dir(xStrPath & "\" & "*.log")
Faça While xFile <> ""
Set xWb = Workbooks.Open(xStrPath & "\" & xFile)
ActiveSheet.UsedRange.Copy xSht.Range("A" & Rows.Count).End(xlUp).Offset(1)
xWb.Fechar Falso
xArquivo = Dir
laço
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox "nenhum arquivo txt", , "Kutools for Excel"
End Sub

e este que usa espaços para adicionar a cada coluna

Sub ImportarTextoParaExcel()
'Atualizar porExtendoffice20180911
Dim xWb como pasta de trabalho
Dim xToBook como pasta de trabalho
Dim xStrPath como String
Dim xFileDialog como FileDialog
Dim xArquivo como String
Dim xFiles como nova coleção
Escurecer eu enquanto
Dim xIntRow por muito tempo
Dim xFNum, xFArr Enquanto
Dim xStrValue como String
Dim xRg como intervalo
Dim xArr
Definir xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = Falso
xFileDialog.Title = "Selecione uma pasta [Kutools for Excel]"
Se xFileDialog.Show = -1 Então
xStrPath = xFileDialog.SelectedItems(1)
Se acabar
If xStrPath = "" Então Exit Sub
If Right(xStrPath, 1) <> "\" Então xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
Se xArquivo = "" Então
MsgBox "Nenhum arquivo encontrado", vbInformation, "Kutools for Excel"
Exit Sub
Se acabar
Faça While xFile <> ""
xFiles. Adicionar xFile, xFile
xArquivo = Dir()
laço
Definir xToBook = ThisWorkbook
On Error Resume Next
Application.ScreenUpdating = False
Se xFiles.Count > 0 Então

Para I = 1 Para xFiles.Count
Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
xWb.Worksheets(1).Copiar após:=xToBook.Sheets(xToBook.Sheets.Count)

ActiveSheet.Name = xWb.Name

xWb.Fechar Falso
xIntRow = ActiveCell.CurrentRegion.Rows.Count
Para xFNum = 1 Para xIntRow
Set xRg = ActiveSheet.Range("A" & xFNum)
xArr = Split(xRg.Text, " ")
Se UBound(xArr) > 0 Então
Para xFArr = 0 Para UBound(xArr)
Se xArr(xFArr) <> "" Então
xRg.Value = xArr(xFArr)
Definir xRg = xRg.Offset(ColumnOffset:=1)
Se acabar
Seguinte
Se acabar
Seguinte
Seguinte
Se acabar
Application.ScreenUpdating = True
End Sub
Este comentário foi feito pelo moderador no site
como fazer se meu arquivo Txt contiver delimitado por vírgula?
Este comentário foi feito pelo moderador no site
Você pode usar a função Localizar e substituir para substituir a vírgula por espaço primeiro e aplicar um dos métodos acima para convertê-lo em arquivo do Excel.
Este comentário foi feito pelo moderador no site
Não tem como mudar isso no código? Eu teria que fazer isso com 130 arquivos
Este comentário foi feito pelo moderador no site
Mesma questão
Este comentário foi feito pelo moderador no site
Para aqueles que ainda precisam de ajuda com isso, substitua xArr = Split(xRg.Text, " ") por xArr = Split(xRg.Text, ",").
Este comentário foi feito pelo moderador no site
Quando executo o módulo conforme fornecido, ele adiciona cada arquivo .txt como uma nova planilha, não como uma nova linha à planilha existente. Existe uma maneira de conseguir isso como saída em vez de novas planilhas para cada arquivo .txt?
Este comentário foi feito pelo moderador no site
Você quer combinar todos os arquivos de texto em uma folha?
Este comentário foi feito pelo moderador no site
Sim, é isso que eu quero também.
Este comentário foi feito pelo moderador no site
Oi, Davinder, você pode tentar abaixo do código vba.
Sub ImportCSVsWithReference()
'UpdatebyKutoolsforExcel20151214
    Dim xSht  As Worksheet
    Dim xWb As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    On Error GoTo ErrHandler
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder [Kutools for Excel]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    Set xSht = ThisWorkbook.ActiveSheet
    If MsgBox("Clear the existing sheet before importing?", vbYesNo, "Kutools for Excel") = vbYes Then xSht.UsedRange.Clear
    Application.ScreenUpdating = False
    xFile = Dir(xStrPath & "\" & "*.txt")
    Do While xFile <> ""
        Set xWb = Workbooks.Open(xStrPath & "\" & xFile)
        ActiveSheet.UsedRange.Copy xSht.Range("A" & Rows.Count).End(xlUp).Offset(1)
        xWb.Close False
        xFile = Dir
    Loop
    Application.ScreenUpdating = True
    Exit Sub
ErrHandler:
    MsgBox "no txt files", , "Kutools for Excel"
End Sub
Este comentário foi feito pelo moderador no site
O código é muito útil, é o único código que encontrei que obtém arquivos txt em massa, a correção que preciso também é o que Joyce e Davinder estão procurando.
É extrair os arquivos .txt e colá-los todos uns embaixo dos outros em uma coluna específica, digamos coluna 'N'.

Além disso, preciso saber se será possível adicionar uma "condição if" para que os arquivos .txt importados fiquem da seguinte forma.
se os arquivos .txt começarem com a letra 'A', devem ser colados na 'folha 1' começando com a célula 'N2'
e se os arquivos .txt começarem com a letra 'B', cole na 'Folha 2' começando com a célula 'N2'
else MsgBox como "Finalidade do arquivo .txt não reconhecido".

Agradeço antecipadamente
Este comentário foi feito pelo moderador no site
Eu tenho esse código funcionou para mim, mas ainda assim, preciso alterar alguns nele.

*Quero colar na mesma planilha sem abrir uma nova planilha e depois copiá-la, pois leva mais tempo.

*precisa inserir uma condicional se os arquivos txt importados forem colados na folha 1 se começarem com a letra A e importados para a Folha 2 se começarem com a letra B


Subtestcopy3()
Dim xWb como pasta de trabalho
Dim xToBook como pasta de trabalho
Dim xStrPath como String
Dim xFileDialog como FileDialog
Dim xArquivo como String
Dim xFiles como nova coleção
Dim i tanto tempo
Escurecer a última linha por muito tempo
Dim Rng como intervalo
Definir xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = Falso
xFileDialog.Title = "Selecione uma pasta [Kutools for Excel]"
Se xFileDialog.Show = -1 Então
xStrPath = xFileDialog.SelectedItems(1)
Se acabar
If xStrPath = "" Então Exit Sub
If Right(xStrPath, 1) <> "\" Então xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
Se xArquivo = "" Então
MsgBox "Nenhum arquivo encontrado", vbInformation, "Kutools for Excel"
Exit Sub
Se acabar
Faça While xFile <> ""
xFiles. Adicionar xFile, xFile
xArquivo = Dir()
laço
Intervalo("N2").Selecione
Definir xToBook = ThisWorkbook
Se xFiles.Count > 0 Então
Para i = 1 Para xFiles.Count
Set xWb = Workbooks.Open(xStrPath & xFiles.Item(i))
xWb. Ativar
'Selecionando e copiando os dados txt
Faixa(Seleção, Seleção.Fim(xlPara Baixo)).Selecione
Selection.Copy
xToBook.Activate
ActiveSheet.Paste
Seleção.End(xlDown).Offset(1).Selecionar
On Error Resume Next
Em erro GoTo 0
xWb.Fechar Falso
Seguinte
Se acabar
End Sub
Este comentário foi feito pelo moderador no site
Desculpe, minhas mãos estão atadas
Este comentário foi feito pelo moderador no site
Oi, meu código é executado, mas importa apenas o primeiro arquivo. Diz que houve um erro de método para copiar. O depurador destaca a seguinte linha de código. Alguma ideia?


xWb.Worksheets(1).Copiar após:=xToBook.Sheets(xToBook.Sheets.Count)
Este comentário foi feito pelo moderador no site
Estou com o mesmo problema, alguma solução encontrada?
Este comentário foi feito pelo moderador no site
Oi katia,
Eu sei que seu comentário é bem antigo, mas eu enfrentei o mesmo problema e consertei desta forma: O módulo tem que ser inserido em uma subpasta do projeto .xlsx ativo. Cometi o erro de copiar o código para uma subpasta do meu PERSONAL.XLSB onde costumo armazenar minhas macros e isso acontece com minhas outras macros, mas não com esta.
Este comentário foi feito pelo moderador no site
Como você excluiria as planilhas no código vba se não quiser duplicatas ao reexecutar o módulo?
Este comentário foi feito pelo moderador no site
Desculpe, Harsh, apenas tome cuidado para evitar a importação repetida.
Este comentário foi feito pelo moderador no site
oi eu quero evitar a remoção de zeros anteriores no excel.

eu tentei abaixo do código, mas não está funcionando


Sub Test ()
Dim xWb como pasta de trabalho
Dim xToBook como pasta de trabalho
Dim xStrPath como String
Dim xFileDialog como FileDialog
Dim xArquivo como String
Dim xFiles como nova coleção
Escurecer eu enquanto
Dim j como longo
Definir xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = Falso
xFileDialog.Title = "Selecione uma pasta"
Se xFileDialog.Show = -1 Então
xStrPath = xFileDialog.SelectedItems(1)
Se acabar
If xStrPath = "" Então Exit Sub
If Right(xStrPath, 1) <> "\" Então xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
Se xArquivo = "" Então
MsgBox "Nenhum arquivo encontrado", vbInformation, "Kutools for Excel"
Exit Sub
Se acabar
Faça While xFile <> ""
xFiles. Adicionar xFile, xFile
xArquivo = Dir()
laço
Definir xToBook = ThisWorkbook
Se xFiles.Count > 0 Então
Para I = 1 Para xFiles.Count
Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
ActiveSheet.Cells.NumberFormat = "@" 'Isso é para fazer o Excel em formato de texto antes de colar os dados do arquivo de texto
xWb.Worksheets(1).Copiar após:=xToBook.Sheets(xToBook.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = xWb.Name
Em erro GoTo 0
xWb.Fechar Falso
Seguinte
Se acabar
End Sub
Este comentário foi feito pelo moderador no site
Pooja, você pode tentar a função Remove Leading Zeros do Kutools for Excel para remover todos os zeros à esquerda da seleção após a importação.
Este comentário foi feito pelo moderador no site
mas não quero remover. Eu quero evitar a remoção de zeros anteriores.
Este comentário foi feito pelo moderador no site
Se você quiser manter os zeros à esquerda, você pode formatá-los como formato de texto pelo formato de célula.
Este comentário foi feito pelo moderador no site
Olá, como você modifica este código para inserir arquivos *.txt na ordem: 1,2,3,4,5,6,7,8,9,10,11, etc. Atualmente o código insere arquivos da seguinte forma: 1,10,11,12,13,14,15,16,17,18,19,2,20,21, XNUMX, etc. Obrigado!
Este comentário foi feito pelo moderador no site
existe alguma chance de obter nomes de planilhas apenas uma parte dos nomes de arquivos txt?

conforme o código acima, todo o nome da planilha está tomando.
Este comentário foi feito pelo moderador no site
muito obrigado fiz o trabalho no office 2007 excel
Este comentário foi feito pelo moderador no site
Oi, meu código é executado, mas importa apenas o primeiro arquivo. Diz que houve um erro de método para copiar. O depurador destaca a seguinte linha de código. Alguma ideia?


xWb.Worksheets(1).Copiar após:=xToBook.Sheets(xToBook.Sheets.Count)
Este comentário foi feito pelo moderador no site
Oi Martinho,
Eu tive o mesmo problema e resolvi alterando esta linha:
Definir xToBook = ThisWorkbook
para
Definir xToBook = ActiveWorkbook
Talvez isso ajude.
Este comentário foi feito pelo moderador no site
0

eu preciso de você ajuda eu não tenho nenhuma idéia vba excel eu quero importar vários arquivos de texto como 13000. o nome do arquivo de texto é igual ao da célula por exemplo (c1 = 112 então o nome do arquivo de texto também é 112) significa que o arquivo de texto 112 é importe o c112.
Este comentário foi feito pelo moderador no site
eu preciso de você ajuda eu não tenho nenhuma idéia vba excel eu quero importar vários arquivos de texto como 13000. o nome do arquivo de texto é igual ao da célula por exemplo (c1 = 112 então o nome do arquivo de texto também é 112) significa que o arquivo de texto 112 é importe o c112.
Este comentário foi feito pelo moderador no site
O código funciona, mas importa cada arquivo de texto para uma nova guia na pasta de trabalho. Alguma ideia de onde no código isso poderia ser alterado para importar o novo arquivo de texto na mesma planilha abaixo dos dados do último arquivo de texto?
Este comentário foi feito pelo moderador no site
No código abaixo, se eu quiser especificar a pasta em vez de selecionar o caminho toda vez que importar um arquivo de texto, qual modificação deve ser feita

CÓDIGO VBA:

Sub ImportaçãoCSVsWithReference()
'UpdatebyKutoolsforExcel20151214
Dim xSht As Planilha
Dim xWb como pasta de trabalho
Dim xStrPath como String
Dim xFileDialog como FileDialog
Dim xArquivo como String
Em caso de erro Ir para ErrHandler
Definir xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = Falso
xFileDialog.Title = "Selecione uma pasta [Kutools for Excel]"
Se xFileDialog.Show = -1 Então
xStrPath = xFileDialog.SelectedItems(1)
Se acabar
If xStrPath = "" Então Exit Sub
Definir xSht = ThisWorkbook.ActiveSheet
If MsgBox("Limpar a planilha existente antes de importar?", vbYesNo, "Kutools for Excel") = vbYes Then xSht.UsedRange.Clear
Application.ScreenUpdating = False
xFile = Dir(xStrPath & "\" & "*.txt")
Faça While xFile <> ""
Set xWb = Workbooks.Open(xStrPath & "\" & xFile)
ActiveSheet.UsedRange.Copy xSht.Range("A" & Rows.Count).End(xlUp).Offset(1)
xWb.Fechar Falso
xArquivo = Dir
laço
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox "nenhum arquivo txt", , "Kutools for Excel"
End Sub
Este comentário foi feito pelo moderador no site
Olá, tente abaixo o código
Sub Test()
'UpdatebyExtendoffice6/7/2016
    Dim xWb As Workbook
    Dim xToBook As Workbook
    Dim xStrPath As String
    Dim xFile As String
    Dim xFiles As New Collection
    Dim I As Long
    xStrPath = "C:\Users\AddinsVM001\Desktop\test" 'Here is the parth you can modify
    If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
    xFile = Dir(xStrPath & "*.txt")
    If xFile = "" Then
        MsgBox "No files found", vbInformation, "Kutools for Excel"
        Exit Sub
    End If
    Do While xFile <> ""
        xFiles.Add xFile, xFile
        xFile = Dir()
    Loop
    Set xToBook = ThisWorkbook
    If xFiles.Count > 0 Then
        For I = 1 To xFiles.Count
            Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
            xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)
            On Error Resume Next
            ActiveSheet.Name = xWb.Name
            On Error GoTo 0
            xWb.Close False
        Next
    End If
End Sub

"C:\Users\AddinsVM001\Desktop\test" é o caminho da pasta da qual você pode importar o arquivo de texto, altere-o conforme necessário.
Este comentário foi feito pelo moderador no site
Oi, obrigado pelo seu valioso código VBA.
No entanto, preciso de um código para vários arquivos txt em 'uma única planilha na planilha, não uma planilha individual para cada arquivo txt'.
O que devo editar seu código para meu propósito?

Obrigado,
Este comentário foi feito pelo moderador no site
Olá, tente abaixo o código
Sub Test()
    'UpdatebyExtendoffice 10/26/2022
    Dim xWb As Workbook
    Dim xToBook As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    Dim xFiles As New Collection
    Dim I As Long
    Dim J As Long
    Dim xRg As Range
    Dim xSaveRg As Range
    Dim xSh As Worksheet
    
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder [Kutools for Excel]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
    xFile = Dir(xStrPath & "*.txt")
    If xFile = "" Then
        MsgBox "No files found", vbInformation, "Kutools for Excel"
        Exit Sub
    End If
    Do While xFile <> ""
        xFiles.Add xFile, xFile
        xFile = Dir()
    Loop
    Set xToBook = ThisWorkbook
    Set xSh = xToBook.Sheets.Add
    Set xRg = xSh.Range("A1")
    J = 1
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    If xFiles.Count > 0 Then
        For I = 1 To xFiles.Count
            Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
            Set xSaveRg = xWb.Worksheets(1).UsedRange
            J = xSaveRg.Rows.Count + 1 + J
            Debug.Print xRg.Address
            xSaveRg.Copy Destination:=xRg
            On Error Resume Next
            xWb.Close False
            
            Set xRg = xSh.Cells(J, 1)
        Next
    End If
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
Este comentário foi feito pelo moderador no site
Isso funciona bem. Mas quando ele importa ele renomeia as planilhas com nome.txt como fazer para manter apenas o nome sem adicionar a extensão .txt na planilha?
Avaliado 3.5 fora do 5
Este comentário foi feito pelo moderador no site
Ok, o nvm encontrou a resposta com a ajuda do Google.
substituir linha:
ActiveSheet.Name = xWb.Name
com:
ActiveSheet.Name = Esquerda(xWb.Name,Len(xWb.Name)-4)
removeria as últimas 4 letras do nome da planilha. Efetivamente me dando o que eu precisava. nome sem .txt
Saúde
Avaliado 4 fora do 5
Este comentário foi feito pelo moderador no site
o código abaixo pode dividir os dados em colunas com base no espaço ou tabulação ao importar o arquivo de texto para as planilhas. Mas não quero uma guia separada para cada arquivo txt, gostaria de todos eles em uma única planilha. A informação é o mesmo formato para cada arquivo. . O que pode ser modificado para permitir que isso seja tudo uma folha em vez de cada arquivo importado ser uma nova guia toda e qualquer ajuda seria apreciada

Sub ImportarTextoParaExcel()
'Atualizar porExtendoffice20180911
Dim xWb como pasta de trabalho
Dim xToBook como pasta de trabalho
Dim xStrPath como String
Dim xFileDialog como FileDialog
Dim xArquivo como String
Dim xFiles como nova coleção
Escurecer eu enquanto
Dim xIntRow por muito tempo
Dim xFNum, xFArr Enquanto
Dim xStrValue como String
Dim xRg como intervalo
Dim xArr
Definir xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = Falso
xFileDialog.Title = "Selecione uma pasta [Kutools for Excel]"
Se xFileDialog.Show = -1 Então
xStrPath = xFileDialog.SelectedItems(1)
Se acabar
If xStrPath = "" Então Exit Sub
If Right(xStrPath, 1) <> "\" Então xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
Se xArquivo = "" Então
MsgBox "Nenhum arquivo encontrado", vbInformation, "Kutools for Excel"
Exit Sub
Se acabar
Faça While xFile <> ""
xFiles. Adicionar xFile, xFile
xArquivo = Dir()
laço
Definir xToBook = ThisWorkbook
On Error Resume Next
Application.ScreenUpdating = False
Se xFiles.Count > 0 Então

Para I = 1 Para xFiles.Count
Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
xWb.Worksheets(1).Copiar após:=xToBook.Sheets(xToBook.Sheets.Count)

ActiveSheet.Name = xWb.Name

xWb.Fechar Falso
xIntRow = ActiveCell.CurrentRegion.Rows.Count
Para xFNum = 1 Para xIntRow
Set xRg = ActiveSheet.Range("A" & xFNum)
xArr = Split(xRg.Text, " ")
Se UBound(xArr) > 0 Então
Para xFArr = 0 Para UBound(xArr)
Se xArr(xFArr) <> "" Então
xRg.Value = xArr(xFArr)
Definir xRg = xRg.Offset(ColumnOffset:=1)
Se acabar
Seguinte
Se acabar
Seguinte
Seguinte
Se acabar
Application.ScreenUpdating = True
End Sub
Este comentário foi feito pelo moderador no site
Olá, Daniel, tente o código abaixo, ele importa todos os arquivos de texto em uma planilha chamada Txt.
Observe que: se o nome do texto for igual ao nome da planilha existente, o arquivo de texto pode não ser importado.
Sub ImportTextToExcel2()

'UpdatebyExtendoffice20230106

Dim xWb As Workbook

Dim xToBook As Workbook

Dim xStrPath As String

Dim xFileDialog As FileDialog

Dim xFile As String

Dim xFiles As New Collection

Dim I As Long

Dim xIntRow As Long

Dim xFNum, xFArr As Long

Dim xStrValue As String

Dim xRg As Range

Dim xArr

Dim xRowL, xRowH As Integer

Dim xTxtWS, xWSD As Worksheet

Dim xTxtWS_Rg As Range

Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)

xFileDialog.AllowMultiSelect = False

xFileDialog.Title = "Select a folder [Kutools for Excel]"

If xFileDialog.Show = -1 Then

xStrPath = xFileDialog.SelectedItems(1)

End If

If xStrPath = "" Then Exit Sub

If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"

xFile = Dir(xStrPath & "*.txt")

If xFile = "" Then

MsgBox "No files found", vbInformation, "Kutools for Excel"

Exit Sub

End If

Do While xFile <> ""

xFiles.Add xFile, xFile

xFile = Dir()

Loop

Set xToBook = ThisWorkbook

On Error Resume Next

Set xTxtWS = xToBook.Worksheets("Txt")

If IsNull(xTxtWS) Or IsEmpty(xTxtWS) Then

    Set xTxtWS = xToBook.Worksheets.Add

    xTxtWS.Name = "Txt"

End If

Application.ScreenUpdating = False

Application.DisplayAlerts = False

xTxtWS.Activate

If xFiles.Count > 0 Then

xRowL = 1

For I = 1 To xFiles.Count

Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))

xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)

Set xWSD = xToBook.Sheets(xToBook.Sheets.Count)

xTxtWS.Activate

xWb.Close False

xIntRow = xWSD.UsedRange.CurrentRegion.Rows.Count

    For xFNum = 1 To xIntRow

        Set xRg = xWSD.Range("A" & xFNum)

        xArr = Split(xRg.Text, " ")

        Set xTxtWS_Rg = xTxtWS.Cells.Range("A" & xRowL)

'        If UBound(xArr) > 0 Then

            For xFArr = 0 To UBound(xArr)

                If xArr(xFArr) <> "" Then

                xTxtWS_Rg.Value = xArr(xFArr)

                Set xTxtWS_Rg = xTxtWS_Rg.Offset(ColumnOffset:=1)

                End If

            Next

'        End If

xRowL = xRowL + 1

    Next

xWSD.Delete

Next

End If

Application.ScreenUpdating = True

Application.DisplayAlerts = True

End Sub


Não há comentários postados aqui ainda
Deixe o seu comentário
Postando como convidado
×
Avalie esta postagem:
0   Personagens
Locais sugeridos

Siga-nos

Copyright © 2009 - www.extendoffice.com. | Todos os direitos reservados. Distribuído por ExtendOffice. | | | Mapa do site
Microsoft e o logotipo do Office são marcas comerciais ou marcas registradas da Microsoft Corporation nos Estados Unidos e / ou em outros países.
Protegido por Sectigo SSL