Macro que funciona con 1500 registros ya no funciona para 15,000 dado que la grabe con 1500 son varias macros

Dante Amor

Hice un excel con varias macros, ya se ejecutan con un solo botón que les asigne, pero como la grabe para 1500 registros ahora que le metí más solo procesa los 1500, cree que me pudiera ayudar para que tome más registros, pienso que se puede hace para que se valla al fin del ultimo registro y de ahí se ejecute pero no eh podido.

2 respuestas

Respuesta
1

Pon un par de macros para actualizarlas, te dejo los ejemplos para que hagas los cambios con otras macros.

Dante Amor SI el código es este

Sub Copiar_Columnas(Control As IRibbonControl)

Application.ScreenUpdating = False
cols = Array("BF", "F", "D", "AZ", "BA", "S", "BT", "BW", "BX", "C", "V", "T", "K", "X", "H", "J")
Set h1 = Sheets("COMPROBANTES CDFI")
Set h2 = Sheets("FORMATO INGRESOS")
For i = LBound(cols) To UBound(cols)
h1.Columns(cols(i)).Copy h2.Cells(1, i + 1)
Next
Application.ScreenUpdating = True
MsgBox "Datos Copiados a hoja FORMATO INGRESOS"
End Sub

Sub Insertar_Columnas(Control As IRibbonControl)
Application.ScreenUpdating = False
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("A2").Select
ActiveCell.FormulaR1C1 = "NUMERO CONSECUTIVO"
Columns("K:K").Select
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Range("K2").Select
ActiveCell.FormulaR1C1 = "RETENCIONES_IMPORTE_ISR"
Range("L2").Select
ActiveCell.FormulaR1C1 = "RETENCIONES_IMPORTE_IVA"
Range("L2").Select
Application.ScreenUpdating = True
End Sub

Sub Ordena(Control As IRibbonControl)
Application.ScreenUpdating = False
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Range("A2").Select
ActiveCell.FormulaR1C1 = "1"
Range("A2").Select

' Aqui es donde creo que debe ir al ultimo registro independientemente si hay 50 o 10,000 registros, solo que cuando grabe la macro la jale hasta la fila 2000
Selection.AutoFill Destination:=Range("A2:A2000"), Type:=xlFillSeries
Range("A2:A2000").Select
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.End(xlUp).Select
Range("A2:B2").Select
Range("B2").Activate
Range(Selection, Selection.End(xlDown)).Select
Range("B2").Select
Selection.End(xlToLeft).Select
Selection.End(xlDown).Select
Selection.End(xlToRight).Select
Selection.End(xlToLeft).Select

'Esta es otra Parte 
Range("A2000:B2000").Select
Range("B2000").Activate
Range(Selection, Selection.End(xlUp)).Select
Range(Selection, Selection.End(xlUp)).Select
Range(Selection, Selection.End(xlUp)).Select
Range(Selection, Selection.End(xlUp)).Select
Range(Selection, Selection.End(xlUp)).Select
Range(Selection, Selection.End(xlUp)).Select
Range(Selection, Selection.End(xlUp)).Select
Range(Selection, Selection.End(xlUp)).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.End(xlToLeft).Select
Selection.End(xlUp).Select
Selection.End(xlUp).Select
Selection.End(xlUp).Select
Range("D2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range("B2").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Range(Selection, Cells(1)).Select
Range("B2").Select
ActiveCell.SpecialCells(xlLastCell).Select
Range("A1").Select
Selection.End(xlToRight).Select
Range("Q1").Select
Selection.End(xlToLeft).Select
Range("A1").Select
Application.ScreenUpdating = True
End Sub

Sub Copiar_Retenciones(Control As IRibbonControl)

col_importe = "I" 'columna de retenciones_importe
col_impuesto = "J" 'columna de retenciones_impuesto
col_isr = "K" 'columna de retención de isr
col_iva = "L" 'columna de retención de iva
Set h = Sheets("FORMATO INGRESOS") 'nombre de la hoja donde tienes los datos
'
For i = 2 To h.Range(col_impuesto & Rows.Count).End(xlUp).Row
Select Case h.Cells(i, col_impuesto)

'Aquí Dante si es posible que pegue ISR e IVA en la misma fila ya que vienen una después de otra. Si se puede que quedaran en la misma fila.
Case "ISR": h.Cells(i, col_isr) = h.Cells(i, col_importe)
Case "IVA": h.Cells(i, col_iva) = h.Cells(i, col_importe)
End Select
Next
MsgBox "IVA e ISR copiados"
End Sub

Sub Rellenar_uuid(Control As IRibbonControl)
Application.ScreenUpdating = False

'Esta va al ultimo registro y de ahí rellena así más o menos debería funcionar las anteriores
ultimafila = Range("A1048576").End(xlUp).Offset(1, 0).Row
Range("B1").Select
Do Until ActiveCell.Row = ultimafila
If ActiveCell = "" Then
Selection.FillDown
End If
ActiveCell.Offset(1, 0).Select
Loop
Application.ScreenUpdating = True
End Sub

Sub Borrar_ceros_ISR_IVA(Control As IRibbonControl)
Application.ScreenUpdating = False
Rows("1:1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$W$16559").AutoFilter Field:=11, Criteria1:=Array( _
"0", "0.00", "0.000", "0.0000"), Operator:=xlFilterValues
Range("K20").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents

'Auiq tambien solo jale la formula y cuando hay mas registros ya no los procesa
ActiveSheet.Range("$A$1:$W$16559").AutoFilter Field:=11
ActiveSheet.Range("$A$1:$W$16559").AutoFilter Field:=12, Criteria1:=Array( _
"0", "0.0", "0.00", "0.000", "0.0000", "0.000000"), Operator:=xlFilterValues
Range("L19").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
ActiveSheet.Range("$A$1:$W$16559").AutoFilter Field:=12
Range("L12").Select
Application.ScreenUpdating = True
End Sub

Sub Concatenar_concepto(Control As IRibbonControl)
Application.ScreenUpdating = False
Sheets("COMPROBANTES CDFI").Select
Rows("1:1").Select
Range("BE1").Activate

'Aquí también solo le di cuando grabe control + flechita abajo para seleccionar el total de filas
Selection.Delete Shift:=xlUp
Columns("BF:BF").Select
Selection.Copy
Sheets("FORMATO INGRESOS").Select
Range("O1").Select
Selection.End(xlToLeft).Select
Columns("B:B").Select
Selection.Insert Shift:=xlToRight
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 12
Columns("S:S").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlToRight
Range("S1").Select
ActiveCell.FormulaR1C1 = "CONCATENADO"
Range("S2").Select
ActiveCell.FormulaR1C1 = _
"=CONCATENARSI(RC[-16]:R[1998]C[-16], RC[-17], RC[-1]:R[1664]C[-1],,,"" "")"
ActiveWindow.SmallScroll Down:=-18

'Auiq también solo jale la macro hasta donde había registros, pero si hay más ya no los procesa
Range("S2").Select
Selection.AutoFill Destination:=Range("S2:S2000")
Range("S2:S2000").Select
Application.ScreenUpdating = True
End Sub

Sub Pegar_Valores_Integrar(Control As IRibbonControl)
Application.ScreenUpdating = False
Range("S1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("R:R").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft

'Aqui también solo jale la macro
Range("B1").Select
ActiveSheet.Range("$A$1:$V$2000").AutoFilter Field:=2, Criteria1:="<>"
Range("Q13").Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Selection.End(xlUp).Select
Range("B2").Select
Application.ScreenUpdating = True
End Sub

Si me pudieran ayudar para que siempre vaya al ultimo registro independientemente de cuantos registros sea, soy nuevo en esto y ya batalle mucho. De antemano muchas gracias expertos.

No entendí muy bien en cuáles macros quieres ayuda. Revisé las primeras 3 y al parecer necesitas el último registro en esta macro:

Sub Ordena(Control As IRibbonControl)
    Application.ScreenUpdating = False
    Rows(1).Delete Shift:=xlUp
    Range("A2") = 1
    u = Range("A" & Rows.Count).End(xlUp).Row
    If u > 2 Then Range("A2").AutoFill Destination:=Range("A2:A" & u), Type:=xlFillSeries
End Sub

Depuré la macro Ordena, porque tenías muchas selecciones de celda pero no hace nada, lo único que hace es borrar la primera fila y rellenar con un consecutivo desde A2 y hasta A y la última fila.


Con mucho gusto te ayudo con todas tus macros, pero cambia la valoración a esta respuesta y crea una nueva pregunta por cada macro. En el desarrollo de la pregunta escribe: "para Dante Amor". Ahí me describes con detalle lo que necesitas.

Sal u dos

¡Gracias! Dante Amor Entonces pondré cada macro en una pregunta. 

Respuesta
1

¿

¿Podrías mandar el código?

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas