Macro tarda mucho y atora el excel (queda en blanco)
Tengo una macro en el libro POR que hace búsqueda en el libro Y, si en el libro Y es exitosa la búsqueda copia del libro Y lo que requiero y lo pega en la ultima fila vacía del libro X.. Funciona bien con pocos datos.. Pero al tener una base de datos de más de 35,000 este queda blanco y se atora.. Ya no lo puedo usar... Me pueden apoyar porafavor (anexo código)
Sub importar_inventario_FECHA() elimina = MsgBox("Importar Cierre de: " & Importa_datos.ComboBox1.Value & vbCr & _ "Fecha: " & Importa_datos.TextBox1.Value & vbCr _ & "El Archivo Se Eliminará Por Seguridad." & vbCr & _ "¿Deseas Continuar?", vbInformation + vbYesNo, "") If elimina = vbNo Then Exit Sub On Error GoTo libro Application.ScreenUpdating = False Application.EnableEvents = False DisplayAlerts = False Dim myfile, mybook, a, b, c As String ruta = ActiveWorkbook.path ChDir ruta myfile = Application.GetOpenFilename(FileFilter:="Selecciona Archivo Indicado (*.xlsx *), *.xlsx*", _ Title:="Seleccione un archivo de Excel") mybook = ActiveWorkbook.Name If myfile = False Then Exit Sub End If Workbooks.Open Filename:=myfile, UpdateLinks:=0 FullName = Split(myfile, Application.PathSeparator) a = FullName(UBound(FullName)) Application.ScreenUpdating = False 'inicializo la variable j 'j = 2 j = Workbooks(mybook).Sheets("INVENTARIOS").Range("A" & Rows.Count).End(xlUp).Row + 1 'comienzo el bucle For i = 1 To j Application.ScreenUpdating = False Set h2 = Workbooks(a).Sheets("INVENTARIOS") Set b = h2.Cells.Find(Importa_datos.ComboBox1.Value & CDate(Importa_datos.TextBox1.Value), lookat:=xlWhole, LookIn:=xlValues) If b Is Nothing Then MsgBox "El Pre-Cierre De: " & UCase(Importa_datos.ComboBox1.Value) & vbCr _ & "Con Fecha: " & CDate(Importa_datos.TextBox1.Value) & vbCr & "No Existe", , "" Application.DisplayAlerts = False Workbooks(a).Close True Exit Sub End If Application.ScreenUpdating = True 'activo la hoja donde están mis datos Workbooks(a).Sheets("INVENTARIOS").Activate If Cells(i, "C").Value = Importa_datos.ComboBox1.Value _ And Cells(i, "AJ").Value = CDate(Importa_datos.TextBox1.Value) Then 'copio la fila entera y la pego Workbooks(a). Sheets("INVENTARIOS").Range(Cells(i, "B"), Cells(i, "AK")).Copy Destination:=Workbooks(mybook). Sheets("INVENTARIOS").Cells(j, "B") j = j + 1 End If Next MsgBox "Impotacion realizada con exito!", vbInformation, "" Workbooks(a).Close True DisplayAlerts = True MsgBox "Se Ha Eliminado el Libro: " & FullName(UBound(FullName)) & vbCr _ & ", Para Otra Actualización Solicitelo A su Jefe Inmediato.", vbInformation, "Cambios Realizados con Exito" Kill FullName(UBound(FullName)) ' este elimina el libro Application.ScreenUpdating = True Importa_datos.ComboBox1 = Empty Importa_datos.TextBox1 = Empty Importa_datos.Height = 86 Exit Sub libro: MsgBox "No se selecciono el archivo indicado." & vbCr & Err.Description, vbCritical, "Error" Workbooks(a).Close True End Sub