Tình huống cần: Mỗi ngày nhận hàng chục file báo cáo sản lượng, tồn kho hay đơn hàng từ nhiều xưởng/bộ phận gửi về (định dạng giống nhau). Thay vì ngồi mở từng file để Copy-Paste thủ công mất cả buổi, dùng Sub này để nối tất cả lại thành một bảng dài chỉ trong vài giây.
Sub này làm được gì:
Chọn file linh hoạt: Hiện hộp thoại để bạn cầm chuột quét chọn hàng loạt file cần gộp (không giới hạn số lượng).
Nối đuôi tự động: Tự động tìm dòng cuối cùng của dữ liệu cũ để dán dữ liệu mới vào tiếp theo, không lo ghi đè.
Tự dọn rác: Xóa sạch các dòng trống phía dưới trước khi gộp để đảm bảo data liền mạch.
Sub MergeSheets()
Dim filePaths As Variant
Dim fileCount As Integer
Dim i As Integer
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim lastRow As Long
Dim sourceRange As Range
Dim destLastRow As Long
filePaths = Application.GetOpenFilename(FileFilter:="Excel Files (*.xlsx), *.xlsx", Title:="Select Files to Merge", MultiSelect:=True)
If Not IsArray(filePaths) Then
MsgBox "Chua chon file.", vbExclamation
Exit Sub
End If
Application.ScreenUpdating = False
Set wsDest = ActiveSheet
If WorksheetFunction.CountA(wsDest.UsedRange) = 0 Then
destLastRow = 1
Else
destLastRow = wsDest.Cells.Find(What:="*", After:=wsDest.Cells(1, 1), LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
End If
wsDest.Rows(destLastRow & ":" & wsDest.Rows.Count).Delete
fileCount = UBound(filePaths)
For i = 1 To fileCount
Set wbSource = Workbooks.Open(filePaths(i))
Set wsSource = wbSource.Sheets(1)
wsSource.Cells(1, 1).Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Set sourceRange = Selection
sourceRange.Copy wsDest.Cells(destLastRow, 1)
destLastRow = destLastRow + sourceRange.Rows.Count
wbSource.Close SaveChanges:=False
Next i
Application.ScreenUpdating = True
MsgBox "Gop sheet thanh cong!", vbInformation
End Sub
Nhận xét
Đăng nhận xét