Como adecuar código para que extraer datos según el rango de fechas de un libro a otro
Tengo el siguiente código, que publicare en mi propia respuesta ya que no me deja publicar todo por aquí
Pero necesito algo como esto:
Workbooks.Open Filename:=mybook, UpdateLinks:=0
a = Sheets("DATOS"). Range("A1:E18500") (las fechas en esta hoja están en la columna B, entonces basado en 2 fechas de inicio y fin, situados en textbox del libro en donde ejecute la macro) este me copie los datos que hayan de fecha a fecha de la columna B)
aa = Sheets("INVENTARIO"). Range("G1:R18500") (las fechas en esta hoja están en la columna C, entonces basado en 2 fechas de inicio y fin.. Situados en textbox del libro en donde ejecute la macro) este me copie los datos que hayan de fecha a fecha de la columna C)
Workbooks(mybook).Close SaveChanges:=True
Sheets("DATOS"). Range("A1:E18500") = a En base a los datos encontrados se copien y se peguen en las mismas hojas del mismo nombre, solo de las fechas seleccionadas, ahora si no hay esas fechas que salga una alerta
Sheets("INVENATRIO"). Range("G1:R18500") = aa Lo mismo para la otra hoja se copien y se peguen en las mismas hojas del mismo nombre, solo de las fechas seleccionadas, ahora si no hay esas fechas que salga una alerta
Espero poder haberme explicado bien..
1 Respuesta
Sub importar_usuarios()
On Error GoTo libro
Application.ScreenUpdating = False
Application.EnableEvents = False
DisplayAlerts = False
Dim fil, uf As Integer
Dim path As Variant
Dim mybook As String
uf = Sheets("DATOS").Range("G" & Rows.Count).End(xlUp).Row
fila = uf + 1
'Encuentra el nombre del archivo
path = Application.GetOpenFilename(FileFilter:="Busca Archivo DinDin (*.xlsx *), *.xlsx*", _
Title:="Seleccione un archivo de Excel")
'si hemos seleccionado algún archivo muestra un cuadro mensaje
FullName = Split(path, Application.PathSeparator)
mybook = FullName(UBound(FullName))
Application.ScreenUpdating = False
Workbooks.Open Filename:=mybook, UpdateLinks:=0
a = Sheets("DATOS").Range("A1:E18500")
aa = Sheets("DATOS").Range("G1:R18500")
Workbooks(mybook).Close SaveChanges:=True
Sheets("DATOS").Range("A1:E18500") = a
Sheets("DATOS").Range("G1:R18500") = aa
DisplayAlerts = True
MsgBox "Cambios Realizados con Exito", vbInformation, "SERVINFO"
Application.ScreenUpdating = True
Exit Sub
libro:
MsgBox "No se selecciono el archivo indicado." & vbCr & Err.Description, vbCritical, "Error"
Workbooks(FullName(UBound(FullName))).Close
End Subespero me puedan apoyar..
En pocas palabras en copiar y pegar datos pero con fechas determinadas.. en dos hojas con diferente lugar de fecha en cada columna--
