Automatically copy rows to sheet based on cell

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