Automatically copy rows to sheet based on cell - vba

Question

I have a main sheet titled Task List with a list of rows, and I need each row to be copied to a specific sheet based on the contents of cells in Column I. There are four other sheets (titled Admin, Engine, Lab, and RD) where these values need to be copied to, depending on the value in Column I. Additionally, there is a separate sheet named Completed that where rows should move to (not copy) which contain the word "Complete" in Column E of the sheet titled Task List.
Below is the code that I have currently that I sourced from a post I found. It's not currently copying anything when I run it. Can anyone suggest new code or modifications to this?
Sub copyRows()
Set a = Sheets("Task List")
Set b = Sheets("Admin")
Set c = Sheets("Engine")
Set d = Sheets("Lab")
Set e = Sheets("RD")
Set f = Sheets("Completed")
Dim t
Dim u
Dim v
Dim w
Dim y As Long
Dim z
t = 2
u = 2
v = 2
w = 2
z = 3
Do Until IsEmpty(a.Range("I" & z))
If a.Range("I" & z) = "Admin" Then
t = t + 1
b.Rows(t).Value = a.Rows(z).Value
End If
If a.Range("I" & z) = "Engine" Then
u = u + 1
c.Rows(u).Value = a.Rows(z).Value
End If
If a.Range("I" & z) = "Lab" Then
v = v + 1
d.Rows(v).Value = a.Rows(z).Value
End If
If a.Range("I" & z) = "RD" Then
w = w + 1
e.Rows(w).Value = a.Rows(z).Value
End If
If a.Range("E" & z) = "COMPLETE" Then
y = f.Range("a" & Rows.Count).End(xlUp).Row + 1
f.Rows(y).Value = a.Rows(z).Value
a.Rows(z).Delete
z = z - 1
End If
z = z + 1
Loop
End Sub

Answer 1

I think the loop is not working correctly. Try this code:
Sub copyRows()
Set a = Sheets("Task List")
Set b = Sheets("Admin")
Set c = Sheets("Engine")
Set d = Sheets("Lab")
Set e = Sheets("RD")
Set f = Sheets("Completed")
Dim t, u, v, w, y, CountLng As Long
CountLng = ActiveSheet.UsedRange.Rows.Count
t = 2
u = 2
v = 2
w = 2
z = 3
For z = CountLng to 3 step -1
If a.Range("I" & z) = "Admin" Then
t = t + 1
b.Rows(t).Value = a.Rows(z).Value
ElseIf a.Range("I" & z) = "Engine" Then
u = u + 1
c.Rows(u).Value = a.Rows(z).Value
ElseIf a.Range("I" & z) = "Lab" Then
v = v + 1
d.Rows(v).Value = a.Rows(z).Value
ElseIf a.Range("I" & z) = "RD" Then
w = w + 1
e.Rows(w).Value = a.Rows(z).Value
End If
If a.Range("E" & z) = "COMPLETE" Then
y = f.Range("a" & Rows.Count).End(xlUp).Row + 1
f.Rows(y).Value = a.Rows(z).Value
a.Rows(z).Delete
End If
Next z
End Sub

Answer 2

Try the AutoFilter method, you'll find it shorter, and faster when dealing with large data sets.
Note: modify Set FilterRng = a.Range(a.Range("I3"), a.Range("I3").End(xlDown)) to the columns where your data lies.
Option Explicit
Sub copyRows()
Dim a As Worksheet
Dim SheetNames As Variant, ShtInd As Variant, FilterRng As Range
Dim CopyRng As Range
Set a = Sheets("Task List")
SheetNames = Array("Admin", "Engine", "Lab", "RD", "Completed")
a.Range("I3").AutoFilter ' <-- expand the range where your data lies
Set FilterRng = a.Range(a.Range("I3"), a.Range("I3").End(xlDown))
' loop through all sheet names in array, except "Task List"
For Each ShtInd In SheetNames
' check if there is a match before setting the AutoFilter (not to get an error)
If Not IsError(Application.Match(ShtInd, a.Range(a.Range("I3"), a.Range("I3").End(xlDown)), 0)) Then
FilterRng.AutoFilter Field:=1, Criteria1:=ShtInd ' <-- sut autofilter according to sheet name
Set CopyRng = FilterRng.SpecialCells(xlCellTypeVisible) ' <-- set range to only visible rows
CopyRng.EntireRow.Copy Sheets(ShtInd).Range("A" & Sheets(ShtInd).Cells(Sheets(ShtInd).Rows.Count, "I").End(xlUp).Row + 1) ' <-- Copy >> paste the entire range to all sheets to first empty row
If ShtInd Like "Completed" Then
CopyRng.EntireRow.Delete xlShiftUp ' <-- delete the entire range related to sheet "Completed"
End If
End If
FilterRng.AutoFilter Field:=1 ' <-- reset filter
Next ShtInd
End Sub