Open File With Latest Date

Something like this:

Sub GetEmployeeCount()
Dim sOpenLastReport As String, Cnt As Long, wb As Workbook

Application.ScreenUpdating = False

Do
    sOpenLastReport = "H:\Desktop\BA.com Daily Production Reports\" & _
                      Format(Date - Cnt, "MM-YY") & "\BA.com_ProductionReport_" & _
                      Format(Date - Cnt, "MM-DD-YY") & ".xlsm"
    
    If Len(Dir(sOpenLastReport)) > 0 Then Exit Do
    Cnt = Cnt + 1
    If Cnt Mod 10 = 0 Then
        If MsgBox("We've checked " & Cnt & " dates and not found a file, keep going backwards?", vbYesNo, "CONTINUE") = vbNo Then Exit Sub
    End If
Loop
    
Set wb = Workbooks.Open(sOpenLastReport)

wb.Sheets("EmployeeCount").Range ("B4:Z17").Copy
ThisWorkbook.Sheets("EmployeeCount").Range("C4").PasteSpecial xlPasteValues

wb.Sheets("EmployeeCount").Range("B35:Z35").Copy
ThisWorkbook.Sheets("EmployeeCount").Range("C35").PasteSpecial xlPasteValues

wb.Close False
Application.ScreenUpdating = True

Exit Sub