After I replaced the Totals Formulas like:
Formula:
=SUM(F2:F2)
to
Formula:
=SUM(F1:F2)
then the routine, finally, seems to have worked - check it out
Sub rmarenyi(): Dim wi As Worksheet, ws As Worksheet, wd As Worksheet, wt As Worksheet
Dim i As Long, s As Long, d As Long, t As Long, R As Range
Set wi = Sheets("ITEMS"): Set ws = Sheets("SOLD"): Set wd = Sheets("DONATED")
Set wt = Sheets("SERVICE TIME")
For i = wi.Range("B" & Rows.count).End(xlUp).Row To 3 Step -1
If wi.Cells(i, 5) = "D" Then
Set R = wi.Cells(i, 1).Resize(1, 5): R.Cut: wd.Cells(2, 1).Resize(1, 5).Insert
wi.Rows(i).EntireRow.Delete Shift:=xlUp
ElseIf wi.Cells(i, 5) = "S" Then
Set R = wi.Rows(i): R.Cut: ws.Cells(2, 1).EntireRow.Insert
Set R = ws.Cells(3, 6).Resize(1, 15): R.Copy ws.Cells(2, 6)
wi.Rows(i).EntireRow.Delete Shift:=xlUp: End If
Next i
End Sub
Bookmarks