Do bài viết còn hơi sơ xài, một số bạn có gặp chút khó khăn khi xử lý, nên mình sẽ viết lại một cách chi tiết hơn hi vọng có thể hỗ trợ gì đó cho các bạn. Đầu tiên tôi sẽ tạo một ví dụ thực tiễn để mô tả lại bài viết này, tôi có một tài liệu excel với nội dung như sau:
Và tôi có tất cả 6 file với định dạng, bố cục, vị trí như file excel trên và để trong thư mục [D:\Z-Test\EXCEL] như sau:
Bạn để ý ở hình trên tôi có tạo 1 file excel hoàn toàn mới tên là [Combine_All_Excel], tiếp theo mở file excel lên và chọn trên thanh menu "View → Macro".
Trong cửa sổ Macro được hiển thị, bạn điền các thông số sau:
- Marco Name: MergeFilesExcel
- Macros in: This Workbook
Trong cửa sổ Module1 điền đoạn mã dưới đây:
Sub MergeFilesExcel()
Dim path As String, ThisWB As String, lngFilecounter As Long
Dim wbDest As Workbook, shtDest As Worksheet, ws As Worksheet
Dim Filename As String, Wkb As Workbook
Dim CopyRng As Range, Dest As Range
Dim RowofCopySheet As Integer
RowofCopySheet = 2
ThisWB = ActiveWorkbook.Name
'Dien duong dan folder chua cac tap tin excel can gom lai.
'Nhu ban thay toi tien duong dan thu muc chua cai file excel cua toi.
path = "D:\Z-Test\EXCEL"
Application.EnableEvents = False
Application.ScreenUpdating = False
Set shtDest = ActiveWorkbook.Sheets(1)
Filename = Dir(path & "\*.xls", vbNormal)
If Len(Filename) = 0 Then Exit Sub
Do Until Filename = vbNullString
If Not Filename = ThisWB Then
Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename)
Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
CopyRng.Copy Dest
Wkb.Close False
End If
Filename = Dir()
Loop
Range("A1").Select
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox "Ket Thuc!"
End Sub
Dim path As String, ThisWB As String, lngFilecounter As Long
Dim wbDest As Workbook, shtDest As Worksheet, ws As Worksheet
Dim Filename As String, Wkb As Workbook
Dim CopyRng As Range, Dest As Range
Dim RowofCopySheet As Integer
RowofCopySheet = 2
ThisWB = ActiveWorkbook.Name
'Dien duong dan folder chua cac tap tin excel can gom lai.
'Nhu ban thay toi tien duong dan thu muc chua cai file excel cua toi.
path = "D:\Z-Test\EXCEL"
Application.EnableEvents = False
Application.ScreenUpdating = False
Set shtDest = ActiveWorkbook.Sheets(1)
Filename = Dir(path & "\*.xls", vbNormal)
If Len(Filename) = 0 Then Exit Sub
Do Until Filename = vbNullString
If Not Filename = ThisWB Then
Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename)
Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
CopyRng.Copy Dest
Wkb.Close False
End If
Filename = Dir()
Loop
Range("A1").Select
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox "Ket Thuc!"
End Sub
Tiếp nhấn nút Run màu xanh bên trên bảng menu icon, hoặc trên thanh menu chọn "Run" → "Run Sub/UserForm F5" để thực thi các lệnh marco vừa tạo.
Sau khi chạy xong một bảng thông báo kết thúc sẽ hiện thị, bạn chọn "OK" để kết thúc quá trình gom các tập tin excel.
Dữ liệu của các tập tin excel sẽ được gom lại trong tập tin [Combine_All_Excel] và dưới đây là kết quả.
À các bạn lưu marco này không copy format(định dạng) nó chỉ copy dữ liệu sang thôi, định dạng hình trên là do tôi chỉnh lại để dễ dàng hình thấy kết quả, 6 dòng màu vàng là dòng dữ liệu bằng đầu của mỗi tập tin.
Thêm một lưu ý nhỏ là nó cũng không copy dòng Header đầu tiên của mỗi tập tin excel nha. Nếu có bất kỳ câu hỏi hay khó khăn gì các bạn có thể phản hồi tại đây, nhớ mô tả chi tiết các vấn đề bạn gặp phải nha, nó sẽ giúp mình hỗ trợ các bạn nhanh hơn.
Write: +Bui Ngoc Son
Không có nhận xét nào:
Đăng nhận xét