Copy Excel Range to Word

Got a question for you guys.
I would like to select a range of cells (A1:D120) and copy only the rows in A-D that have a value of 1 in the F column. I would like to paste the table in a Word doc with no extra blank rows. Then, print that word document to PDF.
Here's what I have so far. It only works for one column and it's not ignoring the zero valued F cells.


Private Sub CommandButtonQuote_Click()

Dim cell As Range
Dim NewRange As Range
Dim MyCount As Long

MyCount = 1

For Each cell In Worksheets("Draft Quote").Range("F1:F120")

If cell.Value = 1 Then
If MyCount = 1 Then Set NewRange = cell.Offset(0, -2)
Set NewRange = Application.Union(NewRange, cell.Offset(0, -2))
MyCount = MyCount + 1
End If

Next cell

NewRange.Copy

Set WordApp = CreateObject("word.Application")
WordApp.Documents.Open "C:\Users\Desktop\New Quote.docx"
WordApp.Visible = True
WordApp.Selection.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=True
Application.CutCopyMode = False
Set WordApp = Nothing