將非空白單元格從 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