I have another question. The way I think you are using this is that you only use one sheet at the time to transfer (copy and paste) from. Is that right?
If so, there should be a better solution then what we have now.
Let us know if that is the case.
This should do what you asked for in Post #15 I think.
Sub Button1_Click()
Dim pjWs As Worksheet, ws As Worksheet, i As Long, lr As Long
Set pjWs = Worksheets("Project")
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> "Project" Then
With ws
lr = .Cells(.Rows.Count, 2).End(xlUp).Row
If WorksheetFunction.Sum(.Range(.Cells(3, 1), .Cells(lr - 10, 1))) > 0 Then
For i = 2 To .Cells(.Rows.Count, 2).End(xlUp).Row - 6
If .Cells(i, 1).Value > 0 Then pjWs.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 4).Value = .Cells(i, 1).Resize(, 4).Value
Next i
If .Cells(lr - 4, 1).Value > 0 Then
pjWs.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(6, 4).Value = .Cells(lr - 5, 1).Resize(6, 4).Value
End If
End If
End With
End If
Next ws
End Sub