Te anexo la macro
Sub Generar()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set h1 = Sheets("BASE")
Set h2 = Sheets("ARCHIVO")
Set h3 = Sheets("VARIABLES")
Set h4 = Sheets("SALIDA")
h2.UsedRange.Offset(1, 0).Clear
j = 2
For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
If h1.Cells(i, "A") <> "" And IsNumeric(h1.Cells(i, "A")) Then
h1.Rows(i).Copy h2.Rows(j)
Set b = h3.Columns("A").Find(h1.Cells(i, "B"), lookat:=xlWhole)
If Not b Is Nothing Then
h2.Cells(j, "E") = h3.Cells(b.Row, "C")
h2.Cells(j, "F") = h3.Cells(b.Row, "D")
h2.Cells(j, "G") = h3.Cells(b.Row, "E")
End If
j = j + 1
End If
Next
Call Salida1(h2, h3, h4)
Call Salida2(h2, h3, h4)
Call Salida3(h2, h3, h4)
MsgBox "Fin"
End Sub
'
Sub Salida3(h2, h3, h4) '
'Por.Dante Amor
h4.Cells.Clear
j = 1
n = 300
For i = 2 To h2.Range("A" & Rows.Count).End(xlUp).Row
If h2.Cells(i, "A") = n Then
nombres = Split(h2.Cells(i, "C"), " ")
If h4.Cells(j, "C") = 16 Or h4.Cells(j, "C") = "016" Then _
ind = "CCT" Else indi = "OTC"
H4.Cells(j, "A") = Format(h2. Cells(i, "B"), "'000000000") 'Id
h4.Cells(j, "B") = nombres(1) 'ape 1
h4.Cells(j, "C") = nombres(2) 'ape 1
h4.Cells(j, "D") = nombres(0) 'nombre
h4.Cells(j, "E") = ind 'indicativo
h4.Cells(j, "F") = Format(h2.Cells(i, "G"), "'000000000000000") 'no. cuenta
h4.Cells(j, "G") = h2.Cells(i, "E") 'banco
'h4.Cells(j, "H")
h4.Cells(j, "I") = "'01" & Format(Month(Date) + 1, "00") & Year(Date)
h4.Cells(j, "J") = Format(h2.Cells(i, "D"), "'00000000000000000000") 'importe
'h4.Cells(j, "K")
h4.Cells(j, "L") = "PAGO ESPECIALIDADES" '2 blancos
j = j + 1
End If
Next
cols = Array("", "9", "15", "15", "65", "3", "15", "3", "3", "8", "20", "1", "20")
For i = 1 To UBound(cols)
h4.Columns(i).ColumnWidth = cols(i)
Next
'
Call guardar(h3, h4, n)
End Sub
' : )
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
' : )