VBA copy ô trong excel khi đang lọc filter (1 người xem)

Sub Copy()

Sheets("Sheet1").Select

Dim rrow As Long
Dim Col As Long

    rrow = ActiveCell.Row
    Col = ActiveCell.Column

    Range(Cells(rrow, Col), Cells(rrow + 5, Col)).Copy
    Cells(rrow + 6, Col).Select
    
Sheets("Sheet2").Select
    Range("D3").PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    
Sheets("Sheet1").Select

End Sub

Dim StartIndex As Long

Sub CopyFilteredRows()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim cell As Range
    Dim visibleCells As Range
    Dim cellArr As Collection
    Dim i As Long, cnt As Long
    Dim lastCopyRow As Long, PasteRow As Long
    
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    
    lastCopyRow = ws1.Cells(ws1.Rows.Count, "G").End(xlUp).Row
    
    
    On Error Resume Next
    Set visibleCells = ws1.Range("G5:G" & lastCopyRow).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    If visibleCells Is Nothing Then Exit Sub
    
    Set cellArr = New Collection
    For Each cell In visibleCells
        cellArr.Add cell
    Next cell
    
    If StartIndex = 0 Then StartIndex = 1
    
    If StartIndex > cellArr.Count Then
        MsgBox "copy xong"
        StartIndex = 1
        Exit Sub
    End If
    
    PasteRow = 3
    ws2.Range("D3:D8").ClearContents
    
    cnt = 0
    For i = StartIndex To cellArr.Count
        ws2.Cells(PasteRow + cnt, "D").Value = cellArr(i).Value
        cnt = cnt + 1
        If cnt = 6 Then Exit For
    Next i
    
    StartIndex = StartIndex + cnt
End Sub

Sub CopyFilteredRows2()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim cell As Range, sel As Range
    Dim visibleCells As Range
    Dim cellArr As Collection
    Dim i As Long, cnt As Long
    Dim lastCopyRow As Long, PasteRow As Long
    Dim StartIndex As Long
    Dim selectedRow As Long

    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("Sheet2")

    lastCopyRow = ws1.Cells(ws1.Rows.Count, "G").End(xlUp).Row

    On Error Resume Next
    Set visibleCells = ws1.Range("G5:G" & lastCopyRow).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If visibleCells Is Nothing Then
        Exit Sub
    End If

    Set cellArr = New Collection
    For Each cell In visibleCells
        cellArr.Add cell
    Next cell

    Set sel = Application.ActiveCell
    If sel Is Nothing Then
        MsgBox "Chua chon o"
        Exit Sub
    End If

    If Intersect(sel, ws1.Range("G5:G" & lastCopyRow)) Is Nothing Then
        MsgBox "Hay chon o G5 tro xuong."
        Exit Sub
    End If

    selectedRow = sel.Row

    For i = 1 To cellArr.Count
        If cellArr(i).Row = selectedRow Then
            StartIndex = i
            Exit For
        End If
    Next i

    If StartIndex = 0 Then
        Exit Sub
    End If

    ws2.Range("D3:D8").ClearContents
    PasteRow = 3
    cnt = 0
    For i = StartIndex To cellArr.Count
        ws2.Cells(PasteRow + cnt, "D").Value = cellArr(i).Value
        cnt = cnt + 1
        If cnt = 6 Then Exit For
    Next i
End Sub

    If StartIndex + 6 <= cellArr.Count Then
        ws1.Cells(cellArr(StartIndex + 6).Row, "G").Select
    Else
        MsgBox "Copy xong"
        Exit Sub
    End If