将非空白单元格从 sheet1 复制并粘贴到 sheet2

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

Answer 2

您的原始代码中有多个问题。 正如cybernetic.nomad 已经指出的那样，尽可能避免使用Select。 您还将NextRow变量设置为始终是工作表中的最后一行，而不是目标工作表中的下一个可用行。 此外，由于您使用 .Select，您的Cells调用不明确。

这是使用 AutoFilter 的另一种方法，因为对于此任务，您可以利用过滤来仅获取填充的单元格，而无需执行循环：

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