Sao chép dữ liệu giữa các Workbook theo điều kiện với VBA Excel

1. Phân tích logic

Để thực hiện tác vụ này, chúng ta cần:

Mở file nguồn chứa dữ liệu.
Lặp qua các dòng (hoặc dùng AutoFilter) để kiểm tra điều kiện.
Sao chép những dòng thỏa mãn.
Dán vào file đích.

2. Code VBA

1. Sử dụng vòng lặp


Sub SaoChepTheoDieuKien()
    Dim wbNguon As Workbook, wbDich As Workbook
    Dim wsNguon As Worksheet, wsDich As Worksheet
    Dim duongDan As String, tieuChi As String
    Dim dongCuoiNguon As Long, dongCuoiDich As Long, i As Long
    
    ' --- THIẾT LẬP THÔNG SỐ ---
    duongDan = "C:\Users\Admin\Documents\Data.xlsx" ' Thay đổi đường dẫn file nguồn
    tieuChi = "Hoàn thành" ' Điều kiện cần lọc
    Set wbDich = ThisWorkbook
    Set wsDich = wbDich.Sheets(1) ' Sheet sẽ dán dữ liệu vào
    
    ' Mở file nguồn (Chế độ chỉ đọc để tránh lỗi)
    Set wbNguon = Workbooks.Open(duongDan, ReadOnly:=True)
    Set wsNguon = wbNguon.Sheets(1) ' Sheet chứa dữ liệu gốc
    
    ' Tìm dòng cuối của file nguồn và file đích
    dongCuoiNguon = wsNguon.Cells(wsNguon.Rows.Count, "A").End(xlUp).Row
    
    ' --- QUÁ TRÌNH SAO CHÉP ---
    For i = 2 To dongCuoiNguon ' Chạy từ dòng 2 (bỏ qua tiêu đề)
        If wsNguon.Cells(i, 2).Value = tieuChi Then ' Kiểm tra cột B (cột 2)
            
            ' Tìm dòng trống cuối cùng ở file đích để dán vào
            dongCuoiDich = wsDich.Cells(wsDich.Rows.Count, "A").End(xlUp).Row + 1
            
            ' Sao chép toàn bộ dòng i
            wsNguon.Rows(i).Copy Destination:=wsDich.Rows(dongCuoiDich)
            
        End If
    Next i
    
    ' Đóng file nguồn và thông báo
    wbNguon.Close SaveChanges:=False
    MsgBox "Đã hoàn thành sao chép dữ liệu!", vbInformation
End Sub

Copy dữ liệu từ worksheet nguồn sang worksheet đích theo tiêu chí bằng vòng lặp

Các lưu ý quan trọng để Code chạy mượt

Tốc độ xử lý

Nếu dữ liệu của bạn lên đến hàng nghìn dòng, việc dùng vòng lặp For…Next sẽ hơi chậm. Khi đó, bạn nên sử dụng AutoFilter hoặc Advanced Filter trong VBA để lọc và copy cả khối dữ liệu cùng lúc.

Tham chiếu đường dẫn

Hãy đảm bảo duongDan là chính xác. Bạn có thể dùng Application.GetOpenFilename để chọn file bằng tay thay vì dán cứng đường dẫn.

Bật/Tắt cập nhật màn hình

Thêm dòng Application.ScreenUpdating = False ở đầu code và True ở cuối code để Macro chạy nhanh hơn và không bị nháy màn hình.

Mẹo nhỏ: Nếu bạn thường xuyên thay đổi tiêu chí, hãy đặt tiêu chí đó vào một ô cụ thể trên Sheet (ví dụ ô B1) rồi gán tieuChi = wsDich.Range(“B1”).Value. Như vậy bạn sẽ không cần mở code ra sửa mỗi khi cần lọc một giá trị khác.

Sử dụng AutoFilter


Sub SaoChepDuLieuNhanh()
    Dim wbNguon As Workbook, wsNguon As Worksheet
    Dim wsDich As Worksheet
    Dim duongDan As String, tieuChi As String
    Dim dongCuoiNguon As Long
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    duongDan = "C:\Users\Admin\Downloads\Data.xlsx"
    tieuChi = "Hoàn thành"
    Set wsDich = ThisWorkbook.Sheets(1)
    On Error Resume Next
    Set wbNguon = Workbooks.Open(duongDan, ReadOnly:=True)
    On Error GoTo 0
    If Not wbNguon Is Nothing Then
        Set wsNguon = wbNguon.Sheets(1)
        dongCuoiNguon = wsNguon.Cells(wsNguon.Rows.Count, "A").End(xlUp).Row
        With wsNguon.Range("A1:B" & dongCuoiNguon)
            .AutoFilter Field:=2, Criteria1:=tieuChi
            If wsNguon.Cells(wsNguon.Rows.Count, "A").End(xlUp).Row > 1 Then
                .Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy
                wsDich.Cells(wsDich.Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
            End If
        End With
        wbNguon.Close SaveChanges:=False
        Application.CutCopyMode = False
    Else
        MsgBox "Không tìm thay file nguon!", vbCritical
    End If
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "Hoàn thành!", vbInformation
End Sub

Những cải tiến ở bản này

SpecialCells(xlCellTypeVisible): Đây là “chìa khóa”. Nó giúp bạn chỉ copy những dòng đang hiển thị sau khi lọc, bỏ qua hàng nghìn dòng không thỏa mãn điều kiện.

PasteSpecial Paste:=xlPasteValues: Chỉ dán giá trị, không dán công thức hay định dạng. Điều này giúp file đích nhẹ hơn và tránh lỗi liên kết (link) giữa các file.

Application.ScreenUpdating = False: Giúp code chạy ngầm. Bạn sẽ không thấy màn hình nhảy liên tục, tốc độ xử lý có thể nhanh gấp 5-10 lần.

Xử lý lỗi (On Error): Nếu đường dẫn file sai, code sẽ thông báo thay vì bị treo (Crash).