Te anexo la macro
Sub CargarTxt()
'Por.Dante Amor
'
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("frm titulos")
Set h2 = l1.Sheets("frm detalle")
'
Call borrarhojas
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Seleccione archivo txt"
.Filters.Clear
.Filters.Add "Archivos txt", "*.txt"
.AllowMultiSelect = False
.InitialFileName = l1.Path & "\"
If Not .Show Then Exit Sub
archivo = .SelectedItems.Item(1)
End With
'
Workbooks.OpenText Filename:=archivo, Origin:=xlWindows, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, _
Comma:=False, Space:=False, Other:=True, OtherChar:=";", _
FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2), Array(5, 2), _
Array(6, 2), Array(7, 2), Array(8, 2), Array(9, 1), Array(10, 1), Array(11, 1), _
Array(12, 1), Array(13, 1), Array(14, 1)), TrailingMinusNumbers:=True
'
Set l2 = ActiveWorkbook
Set h21 = l2.Sheets(1)
j = 6
n = 1
filas_insert = False
For i = 1 To h21.Range("A" & Rows.Count).End(xlUp).Row
If InStr(1, h21.Cells(i, "B"), "-") > 0 Then
'crea hoja, copia encabezado
h1.Copy after:=l1.Sheets(l1.Sheets.Count)
Set h3 = ActiveSheet
h3.Name = "cir " & n
n = n + 1
h3.[A4] = h3.[A4] & h21.Cells(i, "B")
h3.[J3] = h3.[J3] & h21.Cells(i, "A")
j = 6
Else
If h21.Cells(i, "D") = "" Then
If filas_insert Then
j = j + 2
filas_insert = False
End If
'copia detalle
h2.Range("A1:N6").Copy h3.Cells(j, "A")
h3.Cells(j, "A") = "D.N.I.: " & h21.Cells(i, "A") & _
" TITULAR: " & h21.Cells(i, "B")
j = j + 3
Else
filas_insert = True
h3.Rows(j & ":" & j).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
h21.Range("A" & i & ":N" & i).Copy
h3.Range("A" & j).PasteSpecial xlValues
j = j + 1
End If
End If
Next
l2.Close
Sheets(1).Select
Application.ScreenUpdating = True
MsgBox "Fin"
End Sub
'
Sub borrarhojas()
'Por.Dante Amor
Application.DisplayAlerts = False
For h = Sheets.Count To 1 Step -1
If Left(Sheets(h).Name, 3) = "cir" Then
Sheets(h).Delete
End If
Next
End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
Pásame la macro dante [email protected] gracias - Adriel Ortiz Mangia