I'm trying to copy all values from a table where column "E" is not 0 and paste them to another sheet.

I tried this

Sub alt1()
    Dim wsfrom As Worksheet
    Dim wsData As Worksheet
    
    Set wsfrom = Sheets("Alt")
    Set wsData = Sheets("Dat")
    
    Dim lrowdat As Long
    Dim lrowfrom As Long
    
    lrowdat = ThisWorkbook.Sheets("Dat").Cells(Rows.Count, 1).End(xlUp).Row + 1
    lrowfrom = ThisWorkbook.Sheets("Alt").Range("A" & Rows.Count).End(xlUp).Row
    
    For i = 10 To lrowfrom
        If wsfrom.Range("E" & i) <> 0 Then
            wsData.Range("A" & lrowdat).Value = wsfrom.Range("A" & i).Value
            wsData.Range("D" & lrowdat).Value = wsfrom.Range("D" & i).Value
            wsData.Range("E" & lrowdat).Value = wsfrom.Range("E" & i).Value
        End If
    Next i
    
End Sub

I also tried this:

Sub alt2()
    Dim wsfrom As Worksheet
    Dim wsData As Worksheet
    
    Set wsfrom = Sheets("Alt")
    Set wsData = Sheets("Dat")
    
    Dim lrowdat As Long
    Dim lrowfrom As Long
    
    lrowdat = ThisWorkbook.Sheets("Dat").Cells(Rows.Count, 1).End(xlUp).Row + 1
    lrowfrom = ThisWorkbook.Sheets("Alt").Range("A" & Rows.Count).End(xlUp).Row
    
    For i = 10 To lrowfrom
        If wsfrom.Range("E" & i) <> 0 Then
            wsfrom.Range("A" & i).EntireRow.Copy
            wsData.Range("A" & lrowdat).PasteSpecial Paste:=xlPasteValues
        End If
    Next i
End Sub

In both cases I got the last row where "E" value <> 0 copied to the destiny sheet.

How can I copy all the rows where column "E" is not 0.

I'm trying to copy all values from a table where column "E" is not 0 and paste them to another sheet.

I tried this

Sub alt1()
    Dim wsfrom As Worksheet
    Dim wsData As Worksheet
    
    Set wsfrom = Sheets("Alt")
    Set wsData = Sheets("Dat")
    
    Dim lrowdat As Long
    Dim lrowfrom As Long
    
    lrowdat = ThisWorkbook.Sheets("Dat").Cells(Rows.Count, 1).End(xlUp).Row + 1
    lrowfrom = ThisWorkbook.Sheets("Alt").Range("A" & Rows.Count).End(xlUp).Row
    
    For i = 10 To lrowfrom
        If wsfrom.Range("E" & i) <> 0 Then
            wsData.Range("A" & lrowdat).Value = wsfrom.Range("A" & i).Value
            wsData.Range("D" & lrowdat).Value = wsfrom.Range("D" & i).Value
            wsData.Range("E" & lrowdat).Value = wsfrom.Range("E" & i).Value
        End If
    Next i
    
End Sub

I also tried this:

Sub alt2()
    Dim wsfrom As Worksheet
    Dim wsData As Worksheet
    
    Set wsfrom = Sheets("Alt")
    Set wsData = Sheets("Dat")
    
    Dim lrowdat As Long
    Dim lrowfrom As Long
    
    lrowdat = ThisWorkbook.Sheets("Dat").Cells(Rows.Count, 1).End(xlUp).Row + 1
    lrowfrom = ThisWorkbook.Sheets("Alt").Range("A" & Rows.Count).End(xlUp).Row
    
    For i = 10 To lrowfrom
        If wsfrom.Range("E" & i) <> 0 Then
            wsfrom.Range("A" & i).EntireRow.Copy
            wsData.Range("A" & lrowdat).PasteSpecial Paste:=xlPasteValues
        End If
    Next i
End Sub

In both cases I got the last row where "E" value <> 0 copied to the destiny sheet.

How can I copy all the rows where column "E" is not 0.

• excel
• vba

• You need to increment lrowdat after the copy. lrowdat = lrowdat + 1 before EndIf – CDP1802 Commented Dec 29, 2024 at 16:31

2 Answers 2

Option Explicit

Sub alt1()
    Dim arAlt As Variant, lrowdat As Long, n As Long, i As Long
    
    ' copy to array
    With Sheets("Alt")
        arAlt = .Range("A10:E" & .Cells(.Rows.Count, 1).End(xlUp).Row)
    End With
    
    With Sheets("Dat")
        lrowdat = .Cells(Rows.Count, 1).End(xlUp).Row + 1
        
        Application.ScreenUpdating = False
        For i = 1 To UBound(arAlt)
            If arAlt(i, 5) <> 0 Then
                .Cells(lrowdat, "A") = arAlt(i, 1)
                .Cells(lrowdat, "D") = arAlt(i, 4)
                .Cells(lrowdat, "E") = arAlt(i, 5)
                lrowdat = lrowdat + 1
                n = n + 1
            End If
        Next
        Application.ScreenUpdating = True
        
    End With
    
    MsgBox n & " rows copied", vbInformation
    
End Sub

Copy Specific Columns When Row Matches

A Quick Fix

Sub CopyRows()
    
    ' Reference the workbook.
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Reference the source and destination worksheets (located in 'wb').
    Dim sws As Worksheet: Set sws = wb.Sheets("Alt")
    Dim dws As Worksheet: Set dws = wb.Sheets("Dat")
    
    ' Since the condition is that column 'E' must be different than 0,
    ' use it (column 'E') to retrieve the last 'occupied' rows.
    Dim sLastRow As Long:
    sLastRow = sws.Cells(sws.Rows.Count, "E").End(xlUp).Row
    Dim dLastRow As Long:
    dLastRow = dws.Cells(dws.Rows.Count, "E").End(xlUp).Row
    
    ' Set the current destination row.
    Dim dRow As Long: dRow = dLastRow ' current destination row
    
    ' Declare additional variables.
    Dim sRow As Long ' current source row
        
    ' Copy values meeting the condition.
    For sRow = 10 To sLastRow
        If sws.Cells(sRow, "E").Value <> 0 Then ' is not zero and is not empty
        'If Len(CStr(sws.Cells(sRow, "E").Value)) > 0 Then ' is not blank
        'If Not IsEmpty(sws.Cells(sRow, "E").Value) Then ' is not empty
            dRow = dRow + 1 ' next destination row
            dws.Range("A" & dRow).Value = sws.Cells(sRow, "A").Value
            dws.Range("D" & dRow).Value = sws.Cells(sRow, "D").Value
            dws.Range("E" & dRow).Value = sws.Cells(sRow, "E").Value
        End If
    Next sRow ' next source row

    ' Inform.
    MsgBox dRow - dLastRow & " row" & IIf(dRow - dLastRow = 1, "", "s") _
        & " of data copied.", _
        IIf(dRow - dLastRow = 0, vbExclamation, vbInformation)

End Sub