CODEWITHSUNDEEP
excelvba
sprosut
sprosut

Reputation: 3

Copy cell from filtered range, where is only one row

I'm trying to copy data from column in filtered range. The number of filtered rows is always different. First row is header.

I'm using this

ThisWorkbook.Sheets(1).Range("N2:N" & ThisWorkbook.Sheets(1).Range("N" & ThisWorkbook.Sheets(1).Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy

This works fine, when the number of filtered rows is bigger than 1. But when there's only one filtered row (and it should be N2:N2), it will copy the whole used range.

Thanks for advice.

Upvotes: 0

Views: 1025

Answers (2)

GMalc
GMalc

Reputation: 2628

You can test to ensure that there are more visible rows then the Header Row before copying your range. Set your range to a variable, then count the number of visible cells in the range to ensure there are rows to copy. Also, as JvdV pointed you should use N1 as the start. When copying visible cells in a range you should always use Offset to ensure you don't copy the Header Row, and Resize to ensure you don't copy the blank cell at the bottom due to the Offset. Here is a basic example of how to accomplish your task.

Dim rng As Range
Set rng = ThisWorkbook.Sheets(1).Range("D1:D" & ThisWorkbook.Sheets(1).Range("D" & ThisWorkbook.Sheets(1).Rows.Count).End(xlUp).Row)
    If rng.SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
        rng.Resize(rng.Cells.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).Copy
    End If

Upvotes: 0

JohnyL
JohnyL

Reputation: 7152

In order to correctly work with filtered data, you should follow this pattern:

Sub FilterRange()

    Dim rngTable As Range    '//Holds: header + data
    Dim rngData As Range     '//Holds: only data
    Dim rngFiltered As Range '//Holds: filtered range

    '// Our range (data + header)
    Set rngTable = [N1:N100]

    '// Get data only
    With rngTable
        Set rngData = .Offset(1).Resize(.Rows.Count - 1)
    End With

    '// Filter range
    rngTable.AutoFilter Field:=1, Criteria1:="1"

    '// Catch error if no values are filtered
    On Error Resume Next
    Set rngFiltered = rngData.SpecialCells(xlCellTypeVisible)

    '// Check if filtering was successful
    If Err = 0 Then
        '// Do some actions (for instance, copy to Sheet2)
        rngFiltered.Copy Sheets("Sheet2").Cells(1)
    Else
        '// No filtered range
    End If

    '// Get back to error raising
    On Error GoTo 0

End Sub

Upvotes: 1

Related Questions