VBA Code to copy a line based on criteria

[wlbamc]

Hi, I want to automatically copy a line in Excel from one worksheet to another if the option Fast Track is chosen in column P. I currently have the following which copies the columns I need, but it copies every line not just the Fast Track ones.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub

With Application
  .EnableEvents = False
  .ScreenUpdating = False
End With

Select Case Target.Column

  Case Is = 1
    Target.Copy
       Sheets("Pending").Range("A" & Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
       Target.Offset(, 1).Select
       
  Case Is = 2
    Target.Copy
       Sheets("Pending").Range("B" & Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
       Target.Offset(, 1).Select
       
  Case Is = 5
    Target.Copy
       Sheets("Pending").Range("C" & Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
       Target.Offset(, 1).Select
       
  Case Is = 6
    Target.Copy
       Sheets("Pending").Range("G" & Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
       Target.Offset(, 1).Select
       
  Case Is = 7
    Target.Copy
       Sheets("Pending").Range("H" & Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
       Target.Offset(, 1).Select

  Case Is = 8
    Target.Copy
       Sheets("Pending").Range("I" & Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
       Target.Offset(, 1).Select
       
    Case Is = 14
    Target.Copy
       Sheets("Pending").Range("O" & Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
       Target.Offset(1, 1).Select
       
Case Else
    '
       
End Select


With Application
  .EnableEvents = True
  .CutCopyMode = False
  .ScreenUpdating = True
End With

End Sub

Many thanks

 

[Flaiban]

There is no "Fast Track" specified in your code...
Try this code :

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column <> 16 Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target.Value <> "Fast Track" Then Exit Sub

Dim last As Long
    last = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row + 1
    Sheet2.Range("A" & last & ":" & "P" & last).Value = Sheet1.Range("A" & Target.Row & ":" & "P" & Target.Row).Value

End Sub

 

[wlbamc]

There is no "Fast Track" specified in your code...
Try this code :

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column <> 16 Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target.Value <> "Fast Track" Then Exit Sub

Dim last As Long
    last = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row + 1
    Sheet2.Range("A" & last & ":" & "P" & last).Value = Sheet1.Range("A" & Target.Row & ":" & "P" & Target.Row).Value

End Sub

This has only copied through Column P not the rest of the columns which my original code did, am I suppose to be adding this to my code?