Updated code
Sub kit_outstanding()
Dim i As Long, lrow As Long, j As Long
Application.ScreenUpdating = False
With Worksheets("Kit Outstanding")
If .Range("A1") = "" Then .Range("A1:E1").Value = Split("Initials,Item ID,Item Name, Item Description, Amount on Loan", ",")
.Range("A1:E1").Font.Bold = True
lrow = .Range("A" & .Rows.Count).End(xlUp).Row
If lrow > 1 Then .Range("A2:E" & lrow).ClearContents
End With
For i = 1 To Worksheets.Count
With Worksheets(i)
If .Name <> "Stock" And .Name <> "Staff ID" And .Name <> "ScanSheet" And .Name <> "Kit Outstanding" Then
lrow = .Range("A" & .Rows.Count).End(xlUp).Row
For j = 4 To lrow
If .Range("E" & j).Value <> "0" Then
.Rows(j).Copy
Worksheets("Kit Outstanding").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
End If
Next j
End If
End With
Next i
Worksheets("Kit Outstanding").Cells.EntireColumn.AutoFit
MsgBox "Kit Outstanding sheet Updated"
Application.ScreenUpdating = True
End Sub
I have put the condition that it should check if the cell is not equal to 0 and not blank too. I found a blank cell in sheet JG so i put it in. Let me know if you need it removed.
Bookmarks