If you unmerge the cells and place "Away" in each of them then I think this code should work. Merged cells always cause problems.
Sub x()
  
Dim rFind As Range, nCol As Long, r As Long
 
Sheet1.Activate
Set rFind = Rows(2).Find(What:=Date, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
                  SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not rFind Is Nothing Then
    nCol = rFind.Column
    For r = 4 To Cells(Rows.Count, 1).End(xlUp).Row
        If Cells(r, nCol) <> "Away" And Cells(r, 2) <> "Boss" And Cells(r, 2) <> "Senior" Then
            Cells(r, 1).Resize(, 2).Copy Sheet2.Cells(Rows.Count, 1).End(xlUp)(2).Resize(, 2)
        End If
    Next r
End If
     
End Sub