Try this. Every time you run it, it clears the last sheet and copies over the data anew.
Sub x()
Dim rData As Range, rCell As Range
Application.ScreenUpdating = False
With Sheets("CriticalPath")
.UsedRange.Offset(1).Clear
Sheets("Input Milestones").Range("A3", Sheets("Input Milestones").Range("A3").End(xlDown)).copy .Range("A2")
.Range("A2", .Range("A2").End(xlDown)).Offset(, 1).Formula = "=IF(A2<>"""",'Input Milestones'!D3-'Input Milestones'!C3,"""")"
End With
With Sheets("Input Dependencies")
.AutoFilterMode = False
For Each rCell In Sheets("CriticalPath").Range("A2", Sheets("CriticalPath").Range("A2").End(xlDown))
.Range("A2").AutoFilter Field:=2, Criteria1:=rCell
With .AutoFilter.Range
On Error Resume Next
Set rData = .Offset(3, 8).Resize(.Rows.Count - 3, 1).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rData Is Nothing Then
rData.copy
rCell.Offset(, 2).PasteSpecial xlPasteValues, Transpose:=True
Set rData = Nothing
End If
End With
Next rCell
.AutoFilterMode = False
End With
Application.ScreenUpdating = True
End Sub
Bookmarks