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

Añade tu respuesta

Haz clic para o