Buenas tardes, después de haber aplicado en mi aplicación la respuesta (perfecta por cierto) que me ha dado Antoni, me pasa que en el archivo que adjunte funciona bien, pero en el mio no me deja cambiar el año, siempre busca el año actual, lo se por que he cambiado la fecha del ordenador y entonces me busca los datos del 18 o del 17 etc que es lo que he probado y no se por que pasa adjunto el código como ha quedado en la aplicación por si alguien ve donde esta el fallo
Gracias de antemano
Sub Resumen()
Dim D As Worksheet, R As Worksheet, CIF As Range, Fila As Long
Dim NUEVO As Object
Dim i As Integer
Dim Final As Integer
Dim datamenor As Date
Dim datamayor As Date
Application.ScreenUpdating = False
Set D = Sheets("ENTRADAS")
Set R = Sheets("415")'--
'-----------------------------------------------------------------------------
'Aportación de Antoni de Ayudaexcel.com
Fila = 1
R.Range("A4:E" & R.Range("A" & Rows.Count).End(xlUp).Row + 1).ClearContents
For x = 5 To D.Range("A" & Rows.Count).End(xlUp).Row
If D.Range("S" & x) >= CDate(datamenor) And D.Range("S" & x) <= CDate(datamayor) Then
Buenas tardes, después de haber aplicado en mi aplicación la respuesta (perfecta por cierto) que me ha dado Antoni, me pasa que en el archivo que adjunte funciona bien, pero en el mio no me deja cambiar el año, siempre busca el año actual, lo se por que he cambiado la fecha del ordenador y entonces me busca los datos del 18 o del 17 etc que es lo que he probado y no se por que pasa adjunto el código como ha quedado en la aplicación por si alguien ve donde esta el fallo
Gracias de antemano
Sub Resumen()
Dim D As Worksheet, R As Worksheet, CIF As Range, Fila As Long
Dim NUEVO As Object
Dim i As Integer
Dim Final As Integer
Dim datamenor As Date
Dim datamayor As Date
Application.ScreenUpdating = False
Set D = Sheets("ENTRADAS")
Set R = Sheets("415")'--
'----------------------------------------------------------------------------
R.Visible = xlSheetVisible
datamenor = CDate(Usf_Gastos.TextBox99) 'Data inferior
datamayor = CDate(Usf_Gastos.TextBox100) 'data superior
'busco los datos
'-----------------------------------------------------------------------------
'Aportación de Antoni de Ayudaexcel.com
Fila = 1
R.Range("A4:E" & R.Range("A" & Rows.Count).End(xlUp).Row + 1).ClearContents
For x = 5 To D.Range("A" & Rows.Count).End(xlUp).Row
If D.Range("S" & x) >= CDate(datamenor) And D.Range("S" & x) <= CDate(datamayor) Then
Set CIF = R.Columns("B").Find(D.Range("C" & x), , , xlWhole)
If Not CIF Is Nothing Then
R.Range("C" & CIF.Row) = R.Range("C" & CIF.Row) + D.Range("K" & x)
R.Range("D" & CIF.Row) = R.Range("D" & CIF.Row) + D.Range("P" & x)
R.Range("E" & CIF.Row) = R.Range("E" & CIF.Row) + D.Range("R" & x)
Else
Fila = Fila + 1
R.Range("A" & Fila) = D.Range("B" & x)
R.Range("B" & Fila) = D.Range("C" & x)
R.Range("C" & Fila) = D.Range("K" & x)
R.Range("D" & Fila) = D.Range("P" & x)
R.Range("E" & Fila) = D.Range("R" & x)
End If
End If
Next
R.Activate
R.Range("h1") = datamenor: R.Range("i1") = datamayor
R.UsedRange.Sort Key1:=R.Columns("C"), Header:=xlYes 'Ordena por Honorarios
'R.UsedRange.Sort Key1:=R.Columns("B"), Header:=xlYes 'Ordena por CIF
Unload Usf_Gastos
End Sub
PD: No puedo adjuntar la aplicación por que tiene todos los datos de clientes, factura, ventas etc, gracias por vuestra comprensión