¿Cómo extraer ciertos datos y dejarlos juntos en una línea, haciendo siempre lo mismo para todos los registros?
Buscar ciertos datos por ejemplo Nit y el producto, de un excel pero solo debo copiar el numero del nit, el numero del producto y el nombre, todo esto debe quedar junto.
Así esta el registro
Nit... 000000005609763 Producto... 0000000045609763 Nombre... ROBINSON RUIZ JAIME
Así debe quedar
0000000056097630000000045609763 junto con el nombre
1 Respuesta
Respuesta de Dante Amor
1
H o l a : Te anexo la macro
Sub Consolidar()
'Por.Dante Amor
'
Application.ScreenUpdating = False
Set l1 = ThisWorkbook
ruta = l1.Path & "\"
archi = Dir(ruta & "*.txt")
Set h1 = l1.Sheets(1)
h1.Cells.Clear
fila = 1
Do While archi <> ""
Workbooks.OpenText Filename:=archi, Origin:=xlMSDOS, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlNone, _
ConsecutiveDelimiter:=True, Tab:=False, Semicolon:=False, _
Comma:=False, Space:=True, Other:=False, _
FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), _
Array(4, 2), Array(5, 2), Array(6, 2)), _
TrailingMinusNumbers:=True
Set l2 = ActiveWorkbook
Set h2 = l2.Sheets(1)
cad1 = ""
cad2 = ""
cad1 = h2.Range("B1") & h2.Range("D1")
For j = 2 To h2.Cells(2, Columns.Count).End(xlToLeft).Column
cad1 = cad1 & h2.Cells(2, j) & " "
Next
espacio = " "
For j = 2 To h2.Cells(3, Columns.Count).End(xlToLeft).Column
If Left(UCase(h2.Cells(3, j + 1)), 9) = "CANCELADO" Then
largo = Len(cad2) + Len(h2.Cells(3, j))
n = 40 - largo
espacio = String(n, " ")
Else
espacio = " "
End If
If Left(UCase(h2.Cells(3, j)), 9) <> "CANCELADO" Then
cad2 = cad2 & h2.Cells(3, j) & espacio
End If
Next
h1.Cells(fila, "A") = cad1
h1.Cells(fila + 1, "A") = cad2
fila = fila + 4
l2.Close
archi = Dir()
Loop
h1.Columns("A:A").Font.Name = "Courier"
h1.Columns("A:A").Font.Size = 11
h1.Columns("A:A").EntireColumn.AutoFit
Application.ScreenUpdating = True
MsgBox "Proceso Terminado", vbInformation
End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
