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.
There will never be blank lines between them 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
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