View Single Post
 
Old 03-30-2018, 12:20 PM
p45cal's Avatar
p45cal p45cal is offline Windows 10 Office 2010 32bit
Expert
 
Join Date: Apr 2014
Posts: 947
p45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond repute
Default

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
Reply With Quote