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

¿

¿Podrías mandar el código?

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. 

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

Online Department Stores that Delight CustomersAs the popularity of online shopping continues to grow,

6 How to Shop for Clothing and Accessories at an Online Department Store With the ubiquity of online department stores, it has become easier than ever to find great deals on clothing and accessories. However, it can be tricky to know how to shop for...
7 respuestas

Ver distintas hojas de un mismo libro en distintas pantallas

¿Pues no sé si esto se podrá hacer? Una determinada hoja de un libro se puede ver en la pantalla 2 mientras el resto de hojas, del mismo libro, las veo en la pantalla 1...¿Se puede? Si es así, ¿Cómo?
1 respuesta

Macro eliminar filas con valor

Tengo esta macro que me elimina las filas cuando el valor es #N/D, pero me ha dejado de funcionar cuando el valor es #CALC! Me podéis echar una mano. Muchas gracias. Sub Borrar_Filas() Dim ultifila As Integer 'guardo la última fila utilizada en la...
2 respuestas

Encontrar datos no coincidentes excel

Sucede que tengo que comparar dos bases de datos y encontrar los elementos no coincidentes para analizar. Se puede hacer por fórmula pero necesito algo más optimizado. El otro problema es que los datos son más de 1.48.576 capacidad de líneas de...
2 respuestas

ChatGPT Polsku: Innowacyjne Rozwiązania dla Każdego w 2024

ChatGPT Polsku, w najnowszej wersji na rok 2024, oferuje użytkownikom szeroki wachlarz unikalnych funkcji, które sprawiają, że jest to niezastąpione narzędzie w codziennym życiu. Jedną z kluczowych cech, która wyróżnia tę platformę, jest jej...
6 respuestas

¿Cómo resolver num a letras en excel?

En un libro excel habilitado para macros al convertir números a letras, en lugar de aparecer el resultado esperado aparece el mensaje # ¿NOMBRE?.
2 respuestas

Why Fintech is attracting so much attention from investors?

In recent years, financial technology, or "fintech" has become one of the hottest sectors in the tech world, attracting billions of dollars in investment from some of the biggest names in the business. There are a number of reasons why fintech is so...
6 respuestas

´No sé que fórmulas usar para resolverme el problema

La imagen no me la sube y tampoco veo como se sube un fichero, os intentaré explicar lo mejor que pueda mi problema. En una hoja Excel tengo hallados los pagos por formas de pago: SUMAR.SI(D1:D16;"Efectivo";B1:B16), y...
3 respuestas

¿Cómo ajustar texto automáticamente en celdas combinadas en Excel 2019?

Solicito amablemente su valiosa ayuda para ajustar automáticamente un rango de celdas de una columna, he intentado con la opción de ajuste autamático de filas, también con al opción de ajustar texto de la pestaña inicio e incluso con la siguiente...
1 respuesta

Ost to pst freeware software

Stella ost to pst freeware converter software is the excellent software to recover all ost mailbox items in to pst file this software is convert all ost mailbox items like emails items, contacts items, calendars items, task items, notes items and...
15 respuestas