Importar varios archivos de texto en una sola hoja de Excel
He encontrado este código que me viene perfecto, pero pega cada txt uno debajo de otro ( lo pega el 1.txt de a2 a t57, el 2.txt de a58 a t113, el 3.txt de a114 a t169)
Yo necesitaría que lo pegue uno al lado de otro. Que pegue el 1.txt en el rango a2-t57, el 2.txt en el rango u2-an57, el 3.txt de ao2 a bh57...
Sub ProcesarArchivosTexto()
Dim Archivo As Variant
Archivos = Application.GetOpenFilename("Text Files (*.txt), *.txt", , "Seleccionar archivos", , True)
If IsArray(Archivos) = True Then
For x = 1 To UBound(Archivos)
ProcesarArchivo Archivos(x)
Next
MsgBox "*** Se han procesado " & UBound(Archivos) & " archivos ***"
Else
MsgBox "*** No se han seleccionado archivos. Proceso cancelado ***"
End If
End Sub
Private Sub ProcesarArchivo(Archivo As Variant)
celda = Cells(10000, 1).End(xlUp).Offset(1).Row
Cells(celda, 1) = Mid(Archivo, Len(Archivo) - 12, 4)
celda = celda + 1
With ActiveSheet.QueryTables.Add(Connection:= _
TEXT; & Archivo, Destination:=Cells(celda, 1))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=True
End With
End SubOjalá que me podáis ayudar
1 respuesta
Respuesta de Dante Amor
2
Te anexo la macro actualizada
Sub ProcesarArchivosTexto()
Dim Archivo As Variant
Archivos = Application.GetOpenFilename("Text Files (*.txt), *.txt", , "Seleccionar archivos", , True)
fila = 2
col = 1
If IsArray(Archivos) = True Then
For x = 1 To UBound(Archivos)
Call ProcesarArchivo(Archivos(x), fila, col)
col = col + 20
Next
MsgBox "*** Se han procesado " & UBound(Archivos) & " archivos ***"
Else
MsgBox "*** No se han seleccionado archivos. Proceso cancelado ***"
End If
End Sub
'
Private Sub ProcesarArchivo(Archivo, fila, col)
Cells(fila, col) = Mid(Archivo, Len(Archivo) - 12, 4)
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & Archivo, Destination:=Cells(fila + 1, col))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=True
End With
End Sub
Procura ejecutar la macro en una hoja nueva, de lo contrario pueden encimarse los nuevos archivos con los nuevos.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
