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

Hola de nuevo, he vaciado todos los datos del archivo para que si podéis echarle un ojo 

Mil gracias de nuevo

Nada que no se puede cargar pesa demasiado..... a alguien se le ocurre como cargarlo?