excel - 我对这个复制和粘贴宏做错了什么？

Question

我正在尝试使用此方法将非空白单元格从 sheet1 复制并粘贴到 sheet2。应该非常直接，但我收到应用程序/对象错误。我在看什么？

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

复制行

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