Copy macro with blank cells

I am using the following macro (which was modified from a former tip of the week) to copy rows of data starting at column H from Sheet1 to Sheet2 based on the value of column n.

This macro works as there is data in each row starting at column H. I now need to copy column G as well. Column G often has blank cells. When I modify the macro to include column G it stops copying when it finds a blank cell. I need it to continue copying until row H is blank.

Public Sub CopyRows()
Sheets("Sheet1").Select
' Find the last row of data
FinalRow = Range("A65536").End(xlUp).Row
' Loop through each row
For x = 17 To FinalRow
' Decide if to copy based on column n
ThisValue = Range("n" & x).Value
If ThisValue = "Y" Then
Range("h" & x & ":i" & x).Copy
Sheets("Sheet2").Select
NextRow = Range("A65536").End(xlUp).Row + 1
Range("A" & NextRow).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
End If
Next x