a guess:
Code:
Sub blah()
ActiveSheet.Range("A:H").AutoFilter Field:=3, Criteria1:="ANNUAL LEAVE REGULAR HOURS"
Set DataBody = Intersect(ActiveSheet.AutoFilter.Range, ActiveSheet.AutoFilter.Range.Offset(1))
Set AnnHrs = DataBody.Columns(3).SpecialCells(xlCellTypeVisible)
ActiveSheet.Range("A:H").AutoFilter Field:=3, Criteria1:="SICK LEAVE REGULAR HOURS"
Set SicHrs = DataBody.Columns(3).SpecialCells(xlCellTypeVisible)
DataBody.AutoFilter
Set CellFirst = SicHrs.Cells(1)
For Each cll In SicHrs.Cells
Set CellsToCopy = Nothing
Set CellsToCopy = Intersect(AnnHrs, Range(CellFirst.Offset(1), cll.Offset(-1)))
If Not CellsToCopy Is Nothing Then
CellsToCopy.Cells(1).Resize(, 6).Copy CellFirst.Offset(, 10)
CellsToCopy.Cells(1).Resize(, 6).ClearContents
If CellsToCopy.Cells.Count > 1 Then
CellsToCopy.Select
MsgBox "More than one row to copy! Only the first of the selected cells' rows has been moved."
End If
End If
Set CellFirst = cll
Next cll
End Sub