Repetir macro en varias filas

danino4 · el 22 de octubre

Buen dia

Tengo la siguiente macro que lo que hace es generar un archivo en txt, subi un ejemplo de como me genera las polizas (poliza 3)

Esta macro toma los dados de una sola fina, lo que necesito esque la funcion se repita en varias fila, por ejemplo, si se corre en dos filas me debe de crear el txt con la informacion de las dos filas, subo un ejemplo de como necesito que quede en la poliza 2.

Si alguien me pudiera ayudar meseria de mucha utilidad

de antemano gracias.

Póliza3.txt

pólizas2.txt

danino4 · el 22 de octubre

aqui la macro

Sub Crear_Polizas()

    Application.ScreenUpdating = 0


    On Error GoTo saltar

    Fecha = Format(Range("C2"), "yyyymmdd")

    largo = Len(Range("B2"))

    cadena = "P  " & Fecha & "    3         " & Range("l2") & " 1 0           " & Range("B2") & WorksheetFunction.Rept(" ", 100 - largo) & "11 0 0"

    primermov = "M  " & Range("H2") & WorksheetFunction.Rept(" ", 30 - Len(Range("H2"))) & " " & Range("a2") & WorksheetFunction.Rept(" ", 10 - Len(Range("A2"))) & _

    " " & "0 " & Round(Range("f2"), 2) & WorksheetFunction.Rept(" ", 20 - Len(Round(Range("f2"), 2))) & " 0" & WorksheetFunction.Rept(" ", 10) & "0.0" & _

    WorksheetFunction.Rept(" ", 18) & Range("g2") & WorksheetFunction.Rept(" ", 104 - Len(Range("g2"))) & 0


    segundomov = "M  " & Range("j2") & WorksheetFunction.Rept(" ", 30 - Len(Range("j2"))) & " " & Range("a2") & WorksheetFunction.Rept(" ", 10 - Len(Range("A2"))) & _

    " " & "1 " & Round(Range("e2"), 2) & WorksheetFunction.Rept(" ", 20 - Len(Round(Range("e2"), 2))) & " 0" & WorksheetFunction.Rept(" ", 10) & "0.0" & _

    WorksheetFunction.Rept(" ", 18) & Range("g2") & WorksheetFunction.Rept(" ", 104 - Len(Range("g2"))) & 0


    tercermov = "M  " & Range("k2") & WorksheetFunction.Rept(" ", 30 - Len(Range("k2"))) & " " & Range("a2") & WorksheetFunction.Rept(" ", 10 - Len(Range("A2"))) & _

    " " & "1 " & Round(Range("d2"), 2) & WorksheetFunction.Rept(" ", 20 - Len(Round(Range("d2"), 2))) & " 0" & WorksheetFunction.Rept(" ", 10) & "0.0" & _

    WorksheetFunction.Rept(" ", 18) & Range("g2") & WorksheetFunction.Rept(" ", 104 - Len(Range("g2"))) & 0


    ''MsgBox WorksheetFunction.Rept(1, 100)

  ''  MsgBox cadena

    [aa2] = cadena

    [aa3] = primermov

    [aa4] = segundomov

    [aa5] = tercermov


    Columns("Z:AC").EntireColumn.Hidden = False

    Range("AA2").Select

    Range(Selection, Selection.End(xlDown)).Select

    Selection.Copy

    Workbooks.Add

    Range("A1").Select

    Selection.PasteSpecial Paste:=xlValues

    archivo_guardado = False

    On Error GoTo saltar

    file_poliza = Application.GetSaveAsFilename(InitialFileName:="Póliza", _

    fileFilter:="Archivos de texto (*.txt), *.txt", _

    Title:="Guardar archivo como:")

    If file_poliza = False Then GoTo saltar

    ActiveWorkbook.SaveAs Filename:=file_poliza, FileFormat:= _

        xlTextPrinter, CreateBackup:=False


    ''ActiveWorkbook.SaveAs Filename:="D:\poliza.txt", FileFormat:=xlText, _

        CreateBackup:=False

    archivo_guardado = True

saltar:

    ActiveWindow.Close (False)

    If archivo_guardado = False Then MsgBox "El archivo no se guardó", vbInformation

    Columns("AA:AB").EntireColumn.Hidden = True

    Range("i1").Select

    Exit Sub

mensaje:

    MsgBox "Hay errores en la cuentas de clientes"

End Sub

Function QuitarEPCA(Texto As String)

    'Función Quitar Puntos, Comas y Acentos.


    valorbuscado = Array(",", ".", "Á", "á", "É", "é", "Í", "í", "Ó", "ó", "Ú", "ú")

    valordevuelto = Array("", "", "A", "a", "E", "e", "I", "i", "O", "o", "U", "u")


    For i = 0 To 11


    Texto = Trim(Replace(Texto, valorbuscado(i), valordevuelto(i)))

    Texto = WorksheetFunction.Trim(Texto)

    Next

    QuitarEPCA = Texto

End Function[/CODE]