What am I doing wrong with this copy and paste macro?-CodePudding

I'm trying to copy and paste nonblank cells from sheet1 to sheet2 with this method. Should be very straight forward, but I'm getting application/object error. What am I overlooking?

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

CodePudding user response：

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

CodePudding user response：

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