Select only first 5 values of a column after applying a filter to a particular column on a particula-CodePudding

i have applied autofilter to the column,that part pf the code is running properly ,but on that condition there are suppose 20 values in that column but i want only 5 ,any particular code would help

Dim rFirstFilteredRow As Range
    With Worksheets("Sheet1")
        With .Cells(1, 1).CurrentRegion
            ActiveSheet.Range("$A$1:$D$6").AutoFilter Field:=4, Criteria1:="1"
            With .Resize(.Rows.Count - 1, .Rows.Count).Offset(1, 0)
                If CBool(Application.Subtotal(103, .Cells)) Then
                    Set rFirstFilteredRow = _
                      .SpecialCells(xlCellTypeVisible).Columns(2).Cells
                    rFirstFilteredRow.Copy
                    Range("G16").Select
                    ActiveSheet.Paste
                    
                End If
            End With
        End With
    End With
End Sub

this helps in getting first column after filter but not the first five

CodePudding user response：

Just add .Resize(5) when setting the width of rFirstFilteredRow to resize the selection to 5 rows high.

Example below (I shortened the code a lot):

Sub Answer()
Dim rFirstFilteredRow As Range

ActiveSheet.Range("$A$1:$D$6").AutoFilter Field:=4, Criteria1:="1"

With Worksheets("Sheet1").Cells(1, 1).CurrentRegion
    With .Resize(.Rows.Count - 1, .Rows.Count).Offset(1, 0)
        If CBool(Application.Subtotal(103, .Cells)) Then
            ' Select first 5 columns starting at column 2
            Set rFirstFilteredRow = _
              .SpecialCells(xlCellTypeVisible).Columns(2).Resize(5)
            rFirstFilteredRow.Copy
            Range("G16").Select
            ActiveSheet.Paste
        End If
    End With
End With
End Sub

CodePudding user response：

Sub macro2()

    Const MAXROWS = 5
    Dim ws As Worksheet, rng As Range
    Dim i As Long, c As Range
    
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    ws.Range("$A$1:$D$6").AutoFilter Field:=4, Criteria1:="1"
    With ws.Cells(1, 1).CurrentRegion.Columns(2)
        Set rng = .Cells.SpecialCells(xlCellTypeVisible)
    End With
    i = 0
    For Each c In rng.Cells
        If i > 0 Then ' skip header
           ws.Range("G16").Offset(i - 1) = c.Value2
        End If
        i = i   1
        If i > MAXROWS Then Exit For
    Next

End Sub