Cách hợp nhất các trang tính, dữ liệu trong Excel bằng mã VBA

Bến Hà Trương
Bến Hà Trương
Nov 10 2020

Giả sử bạn muốn hợp nhất dữ liệu trong nhiều trang tính khác nhau vào một trang tính duy nhất với mã VBA. Bạn có thể sử dụng  hàm LastRow (như trong ví dụ 1) hoặc LastCol (ở ví dụ 2).

Cách hợp nhất các trang tính, dữ liệu trong Excel bằng mã VBA

Mã VBA để hợp nhất các trang tính, dữ liệu trong Excel

Trong ví dụ này, chúng ta sẽ sử dụng hàm LastRow. Vui lòng thực hiệ theo các bước sau.
1. Trong trang Excel, vui lòng nhấn các phím Alt + F11 cùng lúc để mở cửa sổ Microsoft Visual Basic for Applications.
mở cửa sổ Microsoft Visual Basic for Applications.

2. Trong cửa sổ Microsoft Visual Basic for Applications, nhấp vào Insert > Module . Sau đó sao chép mã VBA bên dưới vào cửa sổ Code.
Mã VBA để hợp nhất các trang tính, dữ liệu trong Excel
Sub CopyRangeFromMultiWorksheets()
    Dim sh As Worksheet
    Dim DestSh As Worksheet
    Dim Last As Long
    Dim CopyRng As Range
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    'Delete the sheet "GitihoMergeSheet" if it exist
    Application.DisplayAlerts = False
    On Error Resume Next
    ActiveWorkbook.Worksheets("GitihoMergeSheet").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    'Add a worksheet with the name "GitihoMergeSheet"
    Set DestSh = ActiveWorkbook.Worksheets.Add
    DestSh.Name = "GitihoMergeSheet"
    'loop through all worksheets and copy the data to the DestSh
    For Each sh In ActiveWorkbook.Worksheets
        If sh.Name <> DestSh.Name Then
            'Find the last row with data on the DestSh
            Last = LastRow(DestSh)
            'Fill in the range that you want to copy
            Set CopyRng = sh.Range("A1:G1")
            'Test if there enough rows in the DestSh to copy all the data
            If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
                MsgBox "There are not enough rows in the Destsh"
                GoTo ExitTheSub
            End If
            'This example copies values/formats, if you only want to copy the
            'values or want to copy everything look at the example below this macro
            CopyRng.Copy
            With DestSh.Cells(Last + 1, "A")
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
            End With
            'Optional: This will copy the sheet name in the H column
            DestSh.Cells(Last + 1, "H").Resize(CopyRng.Rows.Count).Value = sh.Name
        End If
    Next
ExitTheSub:
    Application.Goto DestSh.Cells(1)
    'AutoFit the column width in the DestSh sheet
    DestSh.Columns.AutoFit
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

3. Bấn Run hoặc F5 để chạy mã. Các bảng tính của bạn đã được hợp nhất thành một bảng tính mới tên GitihoMergeSheet gồm các dữ liệu trong phạm vi A1:G1 được hợp nhất từ các trang tính đang hoạt động.
Đừng vội để đoạn mã trên khiến bạn choáng ngợp. Trong phần tiếp theo của hướng dẫn này, chúng ta sẽ phân tách đoạn code VBA để bạn hiểu rõ hơn cách nó hoạt động, sau đó tùy chỉnh nó theo nhu cầu của bạn.
Vui lòng xem thêm khóa học Tuyệt đỉnh VBA - Viết code trong tầm tay để tăng ít nhất 200% năng suất làm việc. Tự động hóa thao tác và nghiệp vụ trên Excel giúp bạn có thể tiết kiệm hàng giờ liền khi phải làm việc với các bảng tính nhàm chán.

Tùy chỉnh code VBA hợp nhất các trang tính trong Excel

Về cơ bản, đoạn code trên sẽ tạo một trang tính mới có tên GitihoMergeSheet để chứa tất cả các trang tính đang hoạt động của bạn.
Mỗi lần bạn chạy mã, đoạn code trên sẽ xóa bất kỳ trang tính nào có tên GitihoMergeSheet - nếu có tồn tại, sau đó tạo một sheets mới. Điều này giúp dữ liệu luôn được cập nhật mỗi khi bạn chạy mã. Ngoài ra, bạn có thể tùy chỉnh đoạn code trên cho phù hợp với nhu cầu của mình.

Hợp nhất một phần hoặc toàn bộ trang tính trong Excel

Bạn có thể tham đổi phạm vị (A1:G1) trong dòng Set CopyRng = sh.Range("A1:G1") thành phạm vi bạn cần sao chép.
Ví dụ:
  • Để sao chép toàn bộ trang tính: Set CopyRng = sh.UsedRange
  • Để sao chép vùng hiện tại của ô A1: Set CopyRng = sh.Range("A1").CurrentRegion
  • Để sao chép toàn bộ hàng hoặc các hàng (ví dụ "1:8") Set CopyRng = sh.Rows("1")

Sao chép mọi thứ hoặc chỉ sao chép giá trị

Đoạn mã VBA để hợp nhất các trang tính excel ở trên đang chạy lệnh sao chép giá trị và định dạng của dữ liệu. Bạn hoàn toàn có thể tùy chỉnh chúng theo nhu cầu của mình.

Trong trường hợp bạn chỉ muốn sao chép giá trị, hãy thay thế đoạn

 CopyRng.Copy
    With DestSh.Cells(Last + 1, "A")
        .PasteSpecial xlPasteValues
        .PasteSpecial xlPasteFormats
        Application.CutCopyMode = False
    End With

Bằng đoạn code sau:

    With CopyRng
        DestSh.Cells(Last + 1, "A").Resize(.Rows.Count, _
            .Columns.Count).Value = .Value
   End With

Hoặc thay thế bằng đoạn code 

CopyRng.Copy DestSh.Cells (Last + 1, "A")
Nếu bạn muốn sao chép tất cả mọi thứ.

Chỉ sao chép một số trang nhất định trong workbook

1. Nếu bạn chỉ muốn sao chép các trang tính với tên bắt đầu bằng Tuần. Hãy thay thế dòng 

    If sh.Name <> DestSh.Name Then 

    bằng dòng

    If LCase(Left(sh.Name, 4)) = "week" Then

    2. Nếu bạn chỉ muốn sao chép những trang tính đang hiểu hiện trong cửa số làm việc của mình. Hay thay thế dòng này:

    For Each sh In ActiveWorkbook.Worksheets

    bằng dòng

    For Each sh In ActiveWorkbook.Sheets (Array ("Sheet1", "Sheet3"))

    3. Nếu bạn chỉ muốn sao chép từ các trang trong một Mảng nhất định. Hãy thay thế dòng

    For Each sh In ActiveWorkbook.Worksheets

    bằng dòng

    For Each sh In ActiveWorkbook.Sheets(Array("Sheet1", "Sheet3"))

    và xóa dòng

    If sh.Name <> DestSh.Name Then 

    và dòng

    End If trước dòng Next

    4. Nếu bạn muỗn bỏ qua nhiều trang tính hơn nữa, hãy thay thể đoạn code

    If sh.Name <> DestSh.Name Then

    bằng đoạn code sau

    If IsError(Application.Match(sh.Name, _
        Array(DestSh.Name, "Total Sheet", "Menu Sheet"), 0)) Then
    Chỉ sao chép dữ liệu từ hàng 2 tới hàna cuối cùng trong trang tính

    Ví dụ này sẽ sử dụng hàm LastRow, tuy nhiên bạn có thể áp dụng các mẹo như đã trình bày ở phần trên để tùy chỉnh đoạn code bên dưới theo nhu cầu của mình.

    Mã VBA Sao chép trang tính từ hàng 2 cho đến hàng cuối cùng với dữ liệu

    Thực hiện các bước từ 1 tới 3 như trong ví dụ 1, tuy nhiên thay thế đoạn code trong bước 2 bằng đoạn code bên dưới

    Sub CopyDataWithoutHeaders()
        Dim sh As Worksheet
        Dim DestSh As Worksheet
        Dim Last As Long
        Dim shLast As Long
        Dim CopyRng As Range
        Dim StartRow As Long
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With
        'Delete the sheet "GitihoMergeSheet" if it exist
        Application.DisplayAlerts = False
        On Error Resume Next
        ActiveWorkbook.Worksheets("GitihoMergeSheet").Delete
        On Error GoTo 0
        Application.DisplayAlerts = True
        'Add a worksheet with the name "GitihoMergeSheet"
        Set DestSh = ActiveWorkbook.Worksheets.Add
        DestSh.Name = "GitihoMergeSheet"
        'Fill in the start row
        StartRow = 2
        'loop through all worksheets and copy the data to the DestSh
        For Each sh In ActiveWorkbook.Worksheets
            If sh.Name <> DestSh.Name Then
                'Find the last row with data on the DestSh and sh
                Last = LastRow(DestSh)
                shLast = LastRow(sh)
                'If sh is not empty and if the last row >= StartRow copy the CopyRng
                If shLast > 0 And shLast >= StartRow Then
                    'Set the range that you want to copy
                    Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))
                    'Test if there enough rows in the DestSh to copy all the data
                    If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
                        MsgBox "There are not enough rows in the Destsh"
                        GoTo ExitTheSub
                    End If
                    'This example copies values/formats, if you only want to copy the
                    'values or want to copy everything look below example 1 on this page
                    CopyRng.Copy
                    With DestSh.Cells(Last + 1, "A")
                        .PasteSpecial xlPasteValues
                        .PasteSpecial xlPasteFormats
                        Application.CutCopyMode = False
                    End With
                End If
            End If
        Next
    ExitTheSub:
        Application.Goto DestSh.Cells(1)
        'AutoFit the column width in the DestSh sheet
        DestSh.Columns.AutoFit
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
    End Sub

    Bạn có thể thấy trong ví dụ 1, chúng ta sao chép trang tính với dòng lệnh Set CopyRng = sh.UsedRange thì ở ví dụ 2 này,  chúng ta bắt đầu với

    'Fill in the start row

    StartRow = 2

    Nếu bạn muốn sao chép hàng tiêu đề trong hàng đầu tiên của GitihoMergeSheet thì hãy sao chép mã bên dưới (nếu mỗi trang tính có cùng tiêu đề) và dán chúng sau dòng If sh.Name <> DestSh.Name Then

    'Copy header row, change the range if you use more columns
    If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then
      sh.Range("A1:Z1").Copy DestSh.Range("A1")
    End If

    Hy vọng qua hướng dẫn này, bạn đã biết được cách sao chép và hợp nhất dữ liệu từ nhiều bảng tính thành một bảng tính duy nhất trong Excel. Phương pháp này giúp bạn tự động hóa quy trình làm việc của mình, chấm dứt hàng giờ copy và dán thủ công nhàm chán. Hơn nữa, mỗi lần bạn chạy mã, dữ liệu của bạn sẽ được cập nhật.

    Xem thêm: Tự học lập trình VBA tại nhà

    Bên cạnh đó, để không bỏ lỡ những mẹo và thủ thuật tin học văn phòng hữu ích khác, hãy tham gia Gitiho ngay hôm nay.

    0/5 - (0 bình chọn)

    0/5 - (0 bình chọn)

    Bài viết liên quan

    Cách ứng dụng hàm INT và MOD cho lễ tân và các công việc khác

    Cách ứng dụng hàm INT và MOD cho lễ tân và các công việc khác

    Hướng dẫn cách tách địa chỉ ra khỏi chuỗi

    Hướng dẫn cách tách địa chỉ ra khỏi chuỗi

    CÁCH TÍNH ĐIỂM TRUNG BÌNH VÀ XẾP LOẠI TRONG EXCEL (KÈM BÀI TẬP)

    CÁCH TÍNH ĐIỂM TRUNG BÌNH VÀ XẾP LOẠI TRONG EXCEL (KÈM BÀI TẬP)

    Hướng dẫn kiểm tra giá trị trùng lặp cực đơn giản trên Excel 2010, 2013, 2016, 2019

    Hướng dẫn kiểm tra giá trị trùng lặp cực đơn giản trên Excel 2010, 2013, 2016, 2019

    Cách cộng, trừ ngày tháng năm trong Excel để tính số ngày siêu nhanh cho kế toán

    Cách cộng, trừ ngày tháng năm trong Excel để tính số ngày siêu nhanh cho kế toán

    Hướng dẫn 4 cách bôi đen trong Excel đơn giản và nhanh chóng

    Hướng dẫn 4 cách bôi đen trong Excel đơn giản và nhanh chóng

    @ 2020 - Bản quyền của Công ty cổ phần công nghệ giáo dục Gitiho Việt Nam
    Giấy chứng nhận Đăng ký doanh nghiệp số: 0109077145, cấp bởi Sở kế hoạch và đầu tư TP. Hà Nội