Copy and paste nonblank cells from sheet1 to sheet2 - excel

Question

I'm trying to copy and paste nonblank cells from sheet1 to sheet2.
I'm getting application/object error.
Public Sub CopyRows()
Sheets("Sheet1").Select
FinalRow = Cells(Rows.Count, 1).End(xlDown).Row
For x = 4 To FinalRow
ThisValue = Cells(x, 1).Value
NextRow = Cells(Rows.Count, 1).End(xlDown).Row
If Not IsEmpty(ThisValue) Then
Cells(x, 1).Resize(1, 6).Copy
Sheets(2).Select
Cells(NextRow, 1).Select
ActiveSheet.Paste
Sheets(1).Select
End If
Next x
End Sub

Answer 1

Copy Rows
Option Explicit
Sub CopyRows()
' Workbook
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Source
Dim sws As Worksheet: Set sws = wb.Worksheets("Sheet1")
Dim slRow As Long: slRow = sws.Cells(sws.Rows.Count, "A").End(xlUp).Row
If slRow < 4 Then Exit Sub ' no data
' Destination
Dim dws As Worksheet: Set dws = wb.Worksheets("Sheet2")
Dim dCell As Range: Set dCell = dws.Cells(dws.Rows.Count, "A").End(xlUp)
Application.ScreenUpdating = False
Dim sCell As Range
Dim sr As Long
' Loop and copy.
For sr = 4 To slRow
Set sCell = sws.Cells(sr, "A")
If Not IsEmpty(sCell) Then
Set dCell = dCell.Offset(1)
sCell.Resize(, 6).Copy dCell
End If
Next sr
Application.ScreenUpdating = True
' Inform.
MsgBox "Rows copied.", vbInformation
End Sub

Answer 2

There are multiple problems in your original code. As cybernetic.nomad already pointed out, avoid using Select whenever possible. You also set your NextRow variable to always be the last row in the worksheet instead of the next available row in your destination sheet. Additionally, because of your use of .Select, you have ambiguous Cells calls.
Here is an alternate method using AutoFilter because, for this task, you can take advantage of filtering to only get populated cells without having to perform a loop:
Sub CopyRows()
Dim wb As Workbook: Set wb = ActiveWorkbook
Dim wsSrc As Worksheet: Set wsSrc = wb.Worksheets("Sheet1")
Dim wsDst As Worksheet: Set wsDst = wb.Worksheets("Sheet2")
Dim rData As Range: Set rData = wsSrc.Range("A3", wsSrc.Cells(wsSrc.Rows.Count, "A").End(xlUp))
If rData.Rows.Count < 2 Then Exit Sub 'No data
With rData
.AutoFilter 1, "<>"
.Offset(1).Resize(, 6).Copy wsDst.Cells(wsDst.Rows.Count, "A").End(xlUp).Offset(1)
.AutoFilter
End With
End Sub