Macro para generar un reporte de excel con condicionales

Solicito de su ayuda para realizar la siguiente operación, requiero una macro que me permita generar un reporte de excel y que se grabe en un libro nuevo de excel tomando el nombre del reporte las columnas ha exportar no son un rango ya que están algunas intercaladas y en posiciones distintas, ademas que este tenga un condicional donde yo le indique que si el monto es >75000<249999  entonces debe imprimir solo los que tengan el monto en ese rango, de igual manera para los que tengan un rango >250000.

1 Respuesta

Respuesta
1

Puedes enviarme tu archivo, me explicas con colores y con comentarios lo que quieres, también me dices de ejemplo cómo quieres que se llame el archivo.

Te anexo la maco con la condición

Sub Banca()
Dim l1 As Workbook
Dim fname As String
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
Dim wbOrigen As Workbook, _
    wsDestino As Excel.Worksheet, _
    wsOrigen As Excel.Worksheet, _
    rngDestino As Excel.Range, _
    rngOrigen As Excel.Range
    'Oculta las acciones del código
    'Indicar el libro de Excel Origen
Dim ruta As Variant
    'ruta = "C:\Users\Naaz-03\Desktop\DataEntrydeCuentasNomina.xls"
    fname = "Banca_privada.xls"
    ruta = ActiveWorkbook.Sheets("Reportes").Range("C13").Value
    'Set wbOrigen = ruta
    If Len(ruta) = 0 Then
       MsgBox "Debe seleccionar un archivo. Hacer doble clic en Examinar", vbCritical
       Exit Sub
    End If
    Workbooks.Open Filename:=ruta
    Filename = Right$(ruta, Len(ruta) - InStrRev(ruta, "\"))
    Set l1 = ActiveWorkbook
    Set h1 = l1.Sheets("Tabla_Datos_Nominados")
    Set h3 = l1.Sheets("Datos_Empresa")
    Set l2 = Workbooks.Add
    Set h2 = ActiveSheet
    L1. Activate
    H1. Columns(23). Copy h2. Columns(4)
    H1. Columns(48). Copy h2. Columns(5)
    H1. Columns(42). Copy h2. Columns(6)
    H1. Columns(44). Copy h2. Columns(7)
    H1. Columns(46). Copy h2. Columns(8)
    For i = 1 To h1.Range("A" & Rows.Count).End(xlUp).Row
        h2.Cells(i, 1) = h1.Cells(i, 5) & " " & h1.Cells(i, 6) & " " & h1.Cells(i, 7) & " " & h1.Cells(i, 8)
    Next
    For i = 1 To h1.Range("B" & Rows.Count).End(xlUp).Row
        h2.Cells(i, 2) = h1.Cells(i, 3) & " " & h1.Cells(i, 4)
    Next
    For i = 1 To h3.Range("C" & Rows.Count).End(xlUp).Row
        h2.Cells(i, 3) = h3.Cells(14, 2) & "," & h3.Cells(14, 3) & "," & h3.Cells(14, 4) & "," & h3.Cells(14, 5) & "," & h3.Cells(14, 6) & "," & h3.Cells(14, 7) & "," & h3.Cells(14, 8) & "," & h3.Cells(14, 9) & "," & h3.Cells(14, 10) & "," & h3.Cells(14, 11) & "," & h3.Cells(14, 12) & "," & h3.Cells(14, 13)
    Next
    h2.Rows("1:7").Delete shift:=xlUp
    h2.Activate
    For i = h2.Range("E" & Rows.Count).End(xlUp).Row To 2 Step -1
        If h2.Cells(i, "E") > 75000 And h2.Cells(i, "E") < 249999 Then
        Else
            h2.Rows(i).Delete
        End If
    Next
    '
    l2.Activate
    Close #FileNum
    ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & fname
    l1.Close
    MsgBox "Archivo excel generado"
End Sub

Saludos.Dante Amor

No olvides valorar la respuesta.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas