Cut and paste rows to new sheet based on different criteria in Column A
As long as all the rows in your working sheet have a valid identifier, you can simplify this process a lot by looking at each row and looking up the Sheet you're supposed to copy the row to.

This allows you to write a single loop instead of a loop for each ID there is:

Dim source As Worksheet
Dim target As Worksheet
Dim targetRow As Long

Set source = ThisWorkbook.Worksheets("Working Sheet")
' As long as there is a row to cut and paste
Do While source.Cells("A2").Value &lt;&gt; vbNullString
  ' select where the row is supposed to go
  Set target = ThisWorkbook.Worksheets(source.Cells("A2").Value)
  targetRow = target.Cells(target.Rows.Count, "A").End(xlUp).Row + 1
  ' and transfer it using copy &amp; delete
  With source.Range("A2").EntireRow
    .Copy target.Range("A" &amp; targetRow)
    .Delete xlShiftUp
  End With
Loop


Of course if that's not the case, this simplification still applies: Iterate the rows of the worksheet once and only Copy&amp;Delete the rows where the identifier matches one of the allowed identifiers.

If deleting the rows from the working sheet is not correct, or you don't want to move every row, you will need to iterate using a For Loop.