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 de Dante Amor
1
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 SubSaludos.Dante Amor
No olvides valorar la respuesta.
