Copy Only Filtered Data From Table Using VBA

40 Views Asked by At

I have a bunch of data with filter on the header. With this code it already able to copy the data according to my needs. However, I want this code to apply only to the visible cells (data shown on the excel after I chose particular filter list on the header).

Private Sub CommandButton1_Click()
    Dim i As Long, j As Long
    Dim arrData, rngData As Range
    Dim arrRes, iR As Long
    Dim oSht1 As Worksheet, oSht2 As Worksheet
    Set oSht1 = Sheets("COBA")
    Set oSht2 = Sheets("AMBIL")
    Set rngData = oSht1.Range("A1").CurrentRegion
    arrData = rngData.Value
    ReDim arrRes(1 To UBound(arrData), 10)
    For i = LBound(arrData) To UBound(arrData)
        If Len(arrData(i, 12)) * Len(arrData(i, 13)) > 0 Then
            iR = iR + 1
            arrRes(iR, 4) = arrData(i, 1)
            arrRes(iR, 5) = arrData(i, 2)
            arrRes(iR, 6) = arrData(i, 6)
            arrRes(iR, 7) = arrData(i, 14)
            arrRes(iR, 8) = arrData(i, 16)
            arrRes(iR, 9) = arrData(i, 17)
            arrRes(iR, 10) = arrData(i, 15)
        End If
    Next i
    If iR > 0 Then
        oSht2.Cells.Clear
        oSht2.Range("A1").Resize(iR, 11).Value = arrRes
    End If
End Sub
1

There are 1 best solutions below

3
Black cat On

You can modify this line:

If Len(arrData(i, 12)) * Len(arrData(i, 13)) > 0 Then

to

If Len(arrData(i, 12)) * Len(arrData(i, 13)) > 0 And rngData.Cells(i, 12).EntireRow.Hidden = False Then