excelvbaexcel-tableslistobject

Copy table rows to clipboard if specified cell in that row not empty


I'm trying to copy a table range with criteria.

How do I define the criteria to copy lines where the CC column has data, skipping the row if CC is empty.
I'll just copy to clipboard, for paste I'll do it manually.
My Table

There will never be blank lines between them like this.
Not like this

Sub CopyValues()

    Application.ScreenUpdating = False
    
    Dim rng As Range
    Dim bottomA As Long
    Dim srcWS As Worksheet
    Set srcWS = Sheets("CC2")
    
    With srcWS
        bottomA = .Range("B" & .Rows.Count).End(xlUp).Row
        For Each rng In .Range("B3:I3" & bottomA)
            If WorksheetFunction.Sum(.Range("B" & rng.Row & ":I" & rng.Row)) > 0 Then
                Range("B" & rng.Row & ":I" & rng.Row)).Copy
            End If
        Next rng
    End With
    
    Application.ScreenUpdating = True
    
End Sub

Solution

  • Copy Filtered Rows From Excel Table (ListObject)

    enter image description here

    Sub CopyFilteredRows()
        
        ' Define constants.
    
        Const WorksheetName As String = "CC2"
        Const TableName As String = "Tabela452"
        Const CriteriaColumnName As String = "CC"
        Const Criteria As String = "<>" ' non-blanks ('blank' includes 'empty')
    
        ' Reference the objects ('wb', 'ws' , 'tbl', 'lc')
    
        Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
        Dim ws As Worksheet: Set ws = wb.Worksheets(WorksheetName)
        Dim tbl As ListObject: Set tbl = ws.ListObjects(TableName)
        Dim lc As ListColumn: Set lc = tbl.ListColumns(CriteriaColumnName)
        
        ' Reference the filtered rows ('rrg').
        
        Dim rrg As Range
        
        With tbl
            If .ShowAutoFilter Then ' autofilter arrows are turned on
                ' Clear all filters.
                If .AutoFilter.FilterMode Then .AutoFilter.ShowAllData
            Else ' autofilter arrows are turned off
                .ShowAutoFilter = True ' turn on the autofilter arrows
            End If
            
            .Range.AutoFilter lc.Index, Criteria
            
            ' Attempt to reference the filtered rows ('rrg').
            On Error Resume Next
                ' Reference the visible cells.
                Set rrg = .DataBodyRange.SpecialCells(xlCellTypeVisible)
                ' When columns are hidden, resize to entire rows of the table.
                Set rrg = Intersect(.DataBodyRange, rrg.EntireRow)
            On Error GoTo 0
            
            ' Clear the filter.
            .AutoFilter.ShowAllData
        End With
    
        ' Invalidate the filtered rows.        
        If rrg Is Nothing Then
            MsgBox "No filtered rows.", vbExclamation
            Exit Sub
        End If
        
        ' Copy.
    
        rrg.Copy
        
    End Sub