Using vba to copy only visible rows

[rammi125]

I have a spreadsheet which each day will have a lot of hidden rows (different rows each day). I want to be able to copy the first ten row of the visible data only and paste it to another spreadsheet, when I currently try to do this with the code below the paste does the first 10 rows including the hidden rows...I thought SpecialCells(xlCellTypeVisible) would help only copy the visible rows, but I was wrong.


Rows("17:3000").Select
Selection.Sort Key1:=Range("v16"), Order1:=xlDescending, Header:=xlGuess _
, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Limit = 10
Idx = 1
Set myRange4 = Range("b17:b3000").SpecialCells(xlCellTypeVisible)
For Each myArea In myRange4.Areas
For Each rw In myArea.Rows
If Idx <= Limit Then
strFltrdRng4 = strFltrdRn4g & rw.Address & ","
Idx = Idx + 1
End If
Next
Next
strFltrdRng4 = Left(strFltrdRng, Len(strFltrdRng) - 1)
Set myFltrdRange4 = Range(strFltrdRng4)
myFltrdRange4.Copy

 

[mumps]

Try:

Sub copyVisRows()
    Application.ScreenUpdating = False
    ActiveSheet.Range("$A$1:$A$100").AutoFilter Field:=1, Criteria1:=Array("a", _
        "c", "e", "g", "h", "i", "j", "k", "l"), Operator:=xlFilterValues
    Dim x As Long
    Dim y As Long
    x = 1
    For y = 2 To Rows.Count
        If Sheets("Sheet1").Cells(y, 1).EntireRow.Hidden = False Then
            Sheets("Sheet1").Cells(y, 1).EntireRow.Copy Sheets("Sheet2").Cells(x, 1)
            x = x + 1
            If x = 11 Then Exit Sub
        End If
    Next y
    Application.ScreenUpdating = True
End Sub

You'll have to change the autofilter range and criteria1 array to match your filter criteria. This also assumes that you have headers in row 1.

 

[Domski]

Maybe something like this:

Sub test()

Dim lngLastRow As Long
Dim x As Long
Dim rngMyRange As Range


lngLastRow = Range("A" & Rows.Count).End(xlUp).Row
x = 1 ' change to row you want to start with


On Error Resume Next
Do Until rngMyRange.Cells.Count = 10 Or x = lngLastRow + 1
On Error GoTo 0
    If Rows(x).Hidden = False Then
        If rngMyRange Is Nothing Then
            Set rngMyRange = Range("A" & x)
        Else
            Set rngMyRange = Union(rngMyRange, Range("A" & x))
        End If
    End If
    x = x + 1
Loop


rngMyRange.EntireRow.Copy Sheets(2).Range("A1")


End Sub

Dom

 

[rammi125]

hey dom, your code worked great in terms of only highlighting the rows that are visible, thank you. I only want to copy column B,F, and R. Do you know the best way to change the code to only copy those rows if they are part of the first 10 visible rows?

 

[rammi125]

hey dom, your code worked great in terms of only highlighting the rows that are visible, thank you. I only want to copy column B,F, and R. Do you know the best way to change the code to only copy those rows if they are part of the first 10 visible rows?

 

[Domski]

Hi,

Maybe like this:

Sub test()

Dim lngLastRow As Long
Dim x As Long
Dim rngMyRange As Range




lngLastRow = Range("B" & Rows.Count).End(xlUp).Row
x = 1 ' change to row you want to start with




On Error Resume Next
Do Until rngMyRange.Cells.Count = 10 Or x = lngLastRow + 1
On Error GoTo 0
    If Rows(x).Hidden = False Then
        If rngMyRange Is Nothing Then
            Set rngMyRange = Range("B" & x)
        Else
            Set rngMyRange = Union(rngMyRange, Range("B" & x))
        End If
    End If
    x = x + 1
Loop




rngMyRange.Copy Sheets(2).Range("A1")
rngMyRange.Offset(0, 4).Copy Sheets(2).Range("B1")
rngMyRange.Offset(0, 16).Copy Sheets(2).Range("C1")


End Sub

Dom