Sub maj()
For i = 2 To Sheets.Count
With Sheets(i)
fin = .Range("a65000").End(xlUp).Row
For j = 2 To fin
If .Cells(j, 3) < Date And .Cells(j, 5) = "" Then
Sheets(1).Range("a65000").End(xlUp).Offset(1, 0) = Sheets(i).Name
Sheets(1).Range("a65000").End(xlUp).Offset(0, 1) = .Cells(j, 2)
Sheets(1).Range("a65000").End(xlUp).Offset(0, 2) = .Cells(j, 3)
Sheets(1).Range("a65000").End(xlUp).Offset(0, 3) = .Cells(j, 4)
End If
Next
End With
Next
End Sub