Copy & Paste Cell Values based on conditions to separate sheets from primary sheet

Hello,
I am stuck on finishing this code. The Input sheet is "Qlik_VT11 that has job numbers in column A. There are 4 output sheets defined below in the code with each having 2 conditions on the inout sheet that determine where the job number will get copied and pasted to. The primary sheet should loop until complete based on Column A. All output sheets will get pasted into Column A with each entry placed under the last. I started code from parts I found online and added the conditions into If & IfElse statements. I'm not sure I have the code correct for looping through the primary sheet and do not have code to place each entry in the output shttes into the next row down. Need some help

Sub Shipments()

Dim LR As Long, i As Long
    With Sheets("Qlik_VT11")
        LR = .Range("A" & Rows.Count).End(xlUp).Row
        
        'erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

        For i = 1 To LR
            With .Range("A" & i)
                If Cells(i, 3).Value = "NW" And Cells(i, 9).Value = "Performance Plastics" Then

                    Sheets("Qlik_VT11").Range("A1:A1").Copy Destination:=Sheets("Performance Plastics").Range("A2:A2")
                    
                ElseIf Cells(i, 3).Value = "NW" And Cells(i, 9).Value = "Specialty Products" Then

                    Sheets("Qlik_VT11").Range("A1:A1").Copy Destination:=Sheets("Specialty Products").Range("A2:A2")
                    
                ElseIf Cells(i, 3).Value = "NW" And Cells(i, 9).Value = "Material Sciences" Then

                    Sheets("Qlik_VT11").Range("A1:A1").Copy Destination:=Sheets("Material Sciences").Range("A2:A2")
                    
                ElseIf Cells(i, 3).Value = "NW" And Cells(i, 9).Value = "Corteva & Performance Materials" Then

                    Sheets("Qlik_VT11").Range("A1:A1").Copy Destination:=Sheets("Corteva & Perf Materials").Range("A2:A2")
                    
                End If
            End With
        Next i
    End With

Hello Welcome to the forum, Spyac,
Could you please warp your code as per forum rule#3
https://www.excelforum.com/forum-rul...rum-rules.html

Try this after you edit your original post and wrap your code in CODE tags (it's a forum rule).

The code below is not tested.

Sub Shipments()
    
    Dim i As Long
    
    With Sheets("Qlik_VT11")
        For i = 1 To .Range("A" & Rows.Count).End(xlUp).Row
            If .Cells(i, 3).Value = "NW" Then
                Select Case .Cells(i, 9).Value
                    Case "Performance Plastics", "Specialty Products", "Material Sciences"
                        .Range("A" & i).Copy Destination:=Sheets(.Cells(i, 9).Value).Range("A" & Rows.Count).End(xlUp).Offset(1)
                    Case "Corteva & Performance Materials"
                        .Range("A" & i).Copy Destination:=Sheets("Corteva & Perf Materials").Range("A" & Rows.Count).End(xlUp).Offset(1)
                End Select
            End If
        Next i
    End With
End Sub

It doesn't make sense that blank cells in column 9 would cause it to fail. It should just ignore them. What exactly happens when it fails? Do you get an error? If yes, what is the error description and what line of code is highlighted when you click the Debug button on the error dialog?

This will copy the blanks to Shipment Review

Sub Shipments()
    
    Dim i As Long
    
    With Sheets("Qlik_VT11")
        For i = 1 To .Range("A" & Rows.Count).End(xlUp).Row
            If .Cells(i, 3).Value = "NW" Then
                Select Case .Cells(i, 9).Value
                    Case "Performance Plastics", "Specialty Products", "Material Sciences"
                        .Range("A" & i).Copy Destination:=Sheets(.Cells(i, 9).Value).Range("A" & Rows.Count).End(xlUp).Offset(1)
                    Case "Corteva & Performance Materials"
                        .Range("A" & i).Copy Destination:=Sheets("Corteva & Perf Materials").Range("A" & Rows.Count).End(xlUp).Offset(1)
                    Case Else
                        .Range("A" & i).Copy Destination:=Sheets("Shipment Review").Range("A" & Rows.Count).End(xlUp).Offset(1)
                End Select
            End If
        Next i
    End With
End Sub

Thanks for the feedback and you're welcome.