Macros importar txt con ciertos datos a Excel
Para Dante Amor
Tengo varios archivos txt y necesito exportarlos a excel, en cierto orden. Te adjunto los archivos que usa y cómo se deben ver en Excel 
también una imagen de los datos que necesito exportar a Excel, te lo agradezco de corazón.
Solo quiero exportar lo que esta en amarillo a excel.
1 Respuesta
Respuesta de Dante Amor
1
Envíame un correo nuevo con los archivos y la explicación. En el asunto del correo me pones tu nombre de usuario: "Jesus Salazar"
Te anexo la macro
Sub ImportarTxt()
'Por.Dante Amor
Application.ScreenUpdating = False
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("test")
ruta = "C:\Trabajo\temporal\"
ruta = ThisWorkbook.Path & "\"
'
arch = Dir(ruta & "*.txt")
h1.Rows("2:" & Rows.Count).Clear
j = 2
Do While arch <> ""
Workbooks.OpenText Filename:=ruta & arch, _
Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlNone, _
ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, Comma:=False, _
Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1)), _
TrailingMinusNumbers:=True
Set l2 = ActiveWorkbook
Set h2 = l2.Sheets(1)
Set b = h2.Columns("A").Find("PTU_Standards", lookat:=xlPart)
If Not b Is Nothing Then
fec = Left(arch, Len(arch) - 4)
h1.Cells(j, "A") = fec
f = b.Row + 3
k = 2
Do While h2.Cells(f, "B") <> ""
If h2.Cells(f, "A") = "Particular" Or Not IsNumeric(h2.Cells(f, "A")) Then
Exit Do
End If
h2.Range(h2.Cells(f, "A"), h2.Cells(f, "G")).Copy h1.Cells(j, k)
k = k + 7
f = f + 1
Loop
j = j + 1
End If
l2.Close False
arch = Dir()
Loop
Application.ScreenUpdating = True
MsgBox "Importación de archivos terminada", vbInformation, "IMPORTAR ARCHIVOS TXT"
End Sub
sal u dos
