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

[eagle12]

Chào các bác

Em có 1 code VBA đang thực hiện việc copy từ ô active kéo xuống 5 dòng --> được 6 dòng copy --> paste sang sheet2

Nhờ mọi người nâng cấp code lên việc nếu bảng giá trị đang bị filter thì vẫn copy được 6 dòng filter từ ô đang active

Vd: Bảng tính đang lọc tại cột F (lọc những ô màu vàng), để con chuột tại ô G5 ---> sẽ chọn được vùng G5:G21( vùng này có 6 dòng cần copy) ---> Selection.SpecialCells(xlCellTypeVisible).Copy copy được 6 dòng đang lọc ---> sang sheet2 paste vào D3
Thực hiên chọn vùng xong và copy, chuột sẽ nhảy xuông ô G25 - là giá trị lọc thứ 7, để nếu bấm chạy macro sẽ tiếp tục chọn xuông dưới 6 dòng

Cám ơn mọi người nhiều

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

 

[LOGANWover]

- Cột Amt đang lọc theo màu và bạn đang muốn copy cột Mã sang sheet 2 bắt đầu từ ô D3, vậy tại sao bạn không copy cả cột mà phải copy 6 dòng rồi lại copy 6 dòng tiếp?
- Copy đoạn G5:G21 paste vào Sheet2 D3 xong chạy macro tiếp đoạn G25:G36 thì paste tiếp vào đâu vậy bạn?

 

[eagle12]

- Cột Amt đang lọc theo màu và bạn đang muốn copy cột Mã sang sheet 2 bắt đầu từ ô D3, vậy tại sao bạn không copy cả cột mà phải copy 6 dòng rồi lại copy 6 dòng tiếp?

Mỗi lần chạy, mình cần copy từ ô đặt chuột cột tại cột G (lần đầu mình có thể chọn đặt từ G5, G12 .. hoặc G17 ) và chỉ copy 6 dòng trở xuống thôi bạn, vì nó liên quan đến mảng check mỗi lần 6 mã bên sheet 2 sau này, nên không cần copy cả cột bạn ạ

Sau mỗi lần chạy, quay lại sheet1 sẽ để chuột tại dòng thứ 7 tính từ lần chạy trước đó

- Copy đoạn G5:G21 paste vào Sheet2 D3 xong chạy macro tiếp đoạn G25:G36 thì paste tiếp vào đâu vậy bạn?

Mỗi lần chạy copy đều dán đè lên sheet2-D3 1 lần bạn ạ

 

[LOGANWover]

Vậy bạn thử dùng code này nhé, hy vọng giúp được bạn:

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