I have a VBA Code that allows the user to select a date on a drop down menu, and when they click the submit button it asks them if they have the correct date before proceeding. When they hit ok it executes the script and copies data from each row into each sheet according to information found in column A.

The problem that I'm having is that the operator needs to be able to pick any day of the year in order to back fill data, this spreadsheet will be rolling out in April, however the yearly data sheets show every day of the year since January 1st. When setting the date in the drop down menu the script cannot process a date more than a few days past the first available date in the other sheets.

For example:

If the yearly data sheets all start on January 1st and January 1st is the first available date, then I can enter the 1st and 2nd without issue, but if I enter in a random date from the year, for example today's date, March 27th the code fails and the coded error message appears.

Is there someone who can help me to modify the code so that it will copy the data over to whichever date is selected, regardless of which dates are empty on the yearly sheets?

Here is the entirety of the code:

Sub Button112_Click()
response = MsgBox("Are you set to today's date?", vbYesNo)
 
If response = vbNo Then
    MsgBox ("Please set the correct date")
    Exit Sub
End If
Application.ScreenUpdating = False
'Modified 3-26-17 2:50 AM EDT
On Error GoTo M
Dim i As Long
Dim SheetName As String
Dim ans As String
Dim rr As Long
Dim MyDate As String
Dim www As Range
Dim Lastrowa As Long
SheetName = "Efficency Report"
Sheets(SheetName).Activate
Dim Lastrow As Long
Lastrow = Sheets(SheetName).Cells(Rows.Count, "A").End(xlUp).Row
MyDate = Sheets(SheetName).Range("B1").Value
    
    For i = 3 To Lastrow
        
        ans = Sheets(SheetName).Cells(i, 1).Value
        rr = Sheets(ans).Cells(Rows.Count, "A").End(xlUp).Row + 1
        Lastrowa = Sheets(ans).Cells(Rows.Count, "A").End(xlUp).Row
        Set www = Sheets(ans).Range("A3:A" & Lastrow).Find(MyDate)
        Sheets(SheetName).Range("D" & i & ":S" & i).Copy
        Sheets(ans).Range("B" & www.Row).PasteSpecial xlPasteValues
        Application.Goto Sheets(ans).Range("A1")
    Next
Application.CutCopyMode = False
Sheets(SheetName).Activate
Range("A1").Select
Application.ScreenUpdating = True
Exit Sub
M:
MsgBox "Some sort of problem has occured" & vbNewLine & _
"Please verify you have the correct date set" & vbNewLine & _
"Please contact your spreadsheet administrator" & vbNewLine _
& "The data has failed to copy over."
End Sub
Using Excel 2010

Please let me know if I need to post additional information such as Screen Shots etc.

Thank you.