Dim MonTab(), x As Integer
For Each c In Range("f10:ar" & [B65000].End(3).Row)
If IsDate(c.Value) Then
If Date < c.Value And Date + 3 >= c.Value Then
x = x + 1
ReDim Preserve MonTab(1 To 4, 1 To x)
MonTab(1, x) = Cells(c.Row, 2)
MonTab(2, x) = Cells(9, c.Column - 1)
MonTab(3, x) = Cells(9, c.Column)
MonTab(4, x) = c.Text
End If
End If
Next
Worksheets("Recap").Range("A1").Resize(UBound(MonTab, 2), UBound(MonTab, 1)) = Application.Transpose(MonTab)
MonTab.erase