Code to copy rows that meet criteria from Microsoft Excel to Microsoft Word not working

Hi, I am new to programming and this is the first VBA project I am working on. I have combined two sources I have found online to achieve my purpose but the code does not seem to be working. Please advise me on what I should change.

Sub CopyYes()
    Dim c As Range
    Dim j As Integer
    Dim Source As Worksheet
    Dim WordApp As Word.Application
    Dim target As Word.Document
    
'Optimize Code
  Application.ScreenUpdating = False
  Application.EnableEvents = False

'Create an Instance of MS Word
  On Error Resume Next

      Set WordApp = GetObject(class:="Word.Application")
    
    'Clear the error between errors
      Err.Clear

    'If MS Word is not already open then open MS Word
      If WordApp Is Nothing Then Set WordApp = CreateObject(class:="Word.Application")
    
    'Handle if the Word Application is not found
      If Err.Number = 429 Then
        MsgBox "Microsoft Word could not be found, aborting."
        GoTo EndRoutine
      End If

  On Error GoTo 0
  
'Make MS Word Visible and Active
  WordApp.Visible = True
  WordApp.Activate
  
' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets(2)
'Create a New Document
Set target = WordApp.Documents.Add

    j = 1     ' Start copying to row 1 in target sheet
    For Each c In Source.Range("E1:E1000")   ' Do 1000 rows
        If c = "2" Then
           Source.Rows(c.Row).Copy
           target.Paragraph(j).Range.PasteExcelTable_
           j = j + 1
        End If
    Next c

EndRoutine:
'Optimize Code
  Application.ScreenUpdating = True
  Application.EnableEvents = True

'Clear The Clipboard
  Application.CutCopyMode = False

    
End Sub