Trong một bài viết trước đây tôi có hướng dẫn một cách dùng macro để nối nhiều tập tin excel thành một tập tin duy nhất | How to combine multiple excel file by macro in Excel 2010? Tuy nhiêu có một trường hợp một bạn mong muốn là copy tất cả các sheets trong các tập tin excel thành một tập tin duy nhất trong một sheet duy nhất thì đoạn macro này không đáp ứng được.
Hôm nay tôi viết một đoạn macro khác để đáp ứng được công việc nối nhiều tập tin excel có nhiều sheet thành một sheet duy nhất trong 1 tập tin excel duy nhất bằng macro trong Excel 2010. (How to combine multiple excel have multi sheets to one sheet in one file by marco in Excel 2010)
Như thường lệ tôi sẽ chuẩn bị một ví dụ để mô tả trong xuyên xuốt bài viết này, đầu tiên như bạn thấy trong hình dưới tôi có chuẩn bị 6 tập tin excel dùng để gom nó thành một tập tin duy nhất tại một sheet duy nhất trong tập tin excel "Combine_All_Excel.xlsx"
Trong tất các tập tin excel từ 1 → 6 tôi đều tạo sẵn dữ liệu cho cả 3 Sheet (sheet 1, sheet 2, sheet 3) trừ Sheet 2 tôi chỉ có tạo dữ liệu 2 sheet để test trong trường hợp tập tin không có số lượng sheet có không đồng bộ. Dữ liệu các bạn thấy trong một tin tin sẽ như sau:
Bây giờ ta sẽ tạo một tập tin excel trắng hoàn toàn mới dùng để gom 6 tập tin excel trên thành một, như trong ví dụ ở hình trên tôi đã tạo tập tin excel tên "Combine_All_Excel.xlsx", sau khi tạo xong mở tập tin này 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:
Tiếp theo bạn copy đoạn mã code bên dưới vào bản soạn thảo Module1 (Code). Đoạn macro này sẽ thực hiện việc copy tất cả dữ liệu ở tất cả các tập tin excel vào Sheet 1 của tập tin excel "Combine_All_Excel.xlsx", bạn lưu ý thay đổi đường dẫn path = "D:\Z-Test\EXCEL" cho tương ứng với thư mục chứa các tập tin excel cần gom.
Sau đó bạn 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 macro vừa tạo.
Sau khi tiến trình 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 macro 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.
Như bạn thấy trong hình tại Sheet 3 tôi bị mất đi dữ liệu của tập excel 002, nhưng nó ko phải là mất mà là tại excel 002 tôi không có Sheet 3 nên macro sẽ bỏ quả và gom tới tập tin excel 003.
Nếu đoạn macro này không đáp ứng được nhu cầu, bạn có thể xem thêm các chủ đề khác về việc nối nhiều tập tin excel thành 1 như sau:
Chúc các bạn thành công, nếu bài viết hữu ích hãy like và comments gì đó nha ^^! nó tạo cho mình có thêm động lực viết bài ^^!
Write: +Bui Ngoc Son
Hôm nay tôi viết một đoạn macro khác để đáp ứng được công việc nối nhiều tập tin excel có nhiều sheet thành một sheet duy nhất trong 1 tập tin excel duy nhất bằng macro trong Excel 2010. (How to combine multiple excel have multi sheets to one sheet in one file by marco in Excel 2010)
Như thường lệ tôi sẽ chuẩn bị một ví dụ để mô tả trong xuyên xuốt bài viết này, đầu tiên như bạn thấy trong hình dưới tôi có chuẩn bị 6 tập tin excel dùng để gom nó thành một tập tin duy nhất tại một sheet duy nhất trong tập tin excel "Combine_All_Excel.xlsx"
Trong tất các tập tin excel từ 1 → 6 tôi đều tạo sẵn dữ liệu cho cả 3 Sheet (sheet 1, sheet 2, sheet 3) trừ Sheet 2 tôi chỉ có tạo dữ liệu 2 sheet để test trong trường hợp tập tin không có số lượng sheet có không đồng bộ. Dữ liệu các bạn thấy trong một tin tin sẽ như sau:
Bây giờ ta sẽ tạo một tập tin excel trắng hoàn toàn mới dùng để gom 6 tập tin excel trên thành một, như trong ví dụ ở hình trên tôi đã tạo tập tin excel tên "Combine_All_Excel.xlsx", sau khi tạo xong mở tập tin này 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:
- Macro Name: MergeFilesExcel
- Macros in: This Workbook
Tiếp theo bạn copy đoạn mã code bên dưới vào bản soạn thảo Module1 (Code). Đoạn macro này sẽ thực hiện việc copy tất cả dữ liệu ở tất cả các tập tin excel vào Sheet 1 của tập tin excel "Combine_All_Excel.xlsx", bạn lưu ý thay đổi đường dẫn path = "D:\Z-Test\EXCEL" cho tương ứng với thư mục chứa các tập tin excel cần gom.
Sub MergeFilesExcel()
Dim ThisWB As String
Dim path As String
Dim lngFilecounter As Long
Dim wbDest As Workbook
Dim shtDest As Worksheet
Dim WS As Worksheet
Dim Filename As String, Wkb, WkbDest As Workbook
Dim CopyRng As Range
Dim Dest As Range
Dim RowofCopySheet As Integer
RowofCopySheet = 1
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)
Dim n As Long
For n = 1 To Wkb.Sheets.Count
'MsgBox Wkb.Sheets(n).Name
If Wkb.Sheets(n).Range("A1").Value = 0 Then
'MsgBox Wkb.Sheets(n).Name & " is empty"
Else
'MsgBox Wkb.Sheets(n).Range("A1").CurrentRegion.Rows.Count & " Row"
'MsgBox ColumnLetter(Wkb.Sheets(n).Range("A1").CurrentRegion.Columns.Count) & " Cols"
Set CopyRng = Wkb.Sheets(n).Range("A2:" & ColumnLetter(Wkb.Sheets(n).Range("A1").CurrentRegion.Columns.Count) & Wkb.Sheets(n).Range("A1").CurrentRegion.Rows.Count)
Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
CopyRng.Copy Dest
End If
Next n
Wkb.Close False
End If
Filename = Dir()
Loop
Range("A1").Select
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox "Ket Thuc!"
End Sub
Function ColumnLetter(ColumnNumber As Long) As String
Dim n As Long
Dim c As Byte
Dim s As String
n = ColumnNumber
Do
c = ((n - 1) Mod 26)
s = Chr(c + 65) & s
n = (n - c) \ 26
Loop While n > 0
ColumnLetter = s
End Function
Dim ThisWB As String
Dim path As String
Dim lngFilecounter As Long
Dim wbDest As Workbook
Dim shtDest As Worksheet
Dim WS As Worksheet
Dim Filename As String, Wkb, WkbDest As Workbook
Dim CopyRng As Range
Dim Dest As Range
Dim RowofCopySheet As Integer
RowofCopySheet = 1
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)
Dim n As Long
For n = 1 To Wkb.Sheets.Count
'MsgBox Wkb.Sheets(n).Name
If Wkb.Sheets(n).Range("A1").Value = 0 Then
'MsgBox Wkb.Sheets(n).Name & " is empty"
Else
'MsgBox Wkb.Sheets(n).Range("A1").CurrentRegion.Rows.Count & " Row"
'MsgBox ColumnLetter(Wkb.Sheets(n).Range("A1").CurrentRegion.Columns.Count) & " Cols"
Set CopyRng = Wkb.Sheets(n).Range("A2:" & ColumnLetter(Wkb.Sheets(n).Range("A1").CurrentRegion.Columns.Count) & Wkb.Sheets(n).Range("A1").CurrentRegion.Rows.Count)
Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
CopyRng.Copy Dest
End If
Next n
Wkb.Close False
End If
Filename = Dir()
Loop
Range("A1").Select
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox "Ket Thuc!"
End Sub
Function ColumnLetter(ColumnNumber As Long) As String
Dim n As Long
Dim c As Byte
Dim s As String
n = ColumnNumber
Do
c = ((n - 1) Mod 26)
s = Chr(c + 65) & s
n = (n - c) \ 26
Loop While n > 0
ColumnLetter = s
End Function
Sau đó bạn 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 macro vừa tạo.
Sau khi tiến trình 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 macro 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.
Như bạn thấy trong hình tại Sheet 3 tôi bị mất đi dữ liệu của tập excel 002, nhưng nó ko phải là mất mà là tại excel 002 tôi không có Sheet 3 nên macro sẽ bỏ quả và gom tới tập tin excel 003.
Nếu đoạn macro này không đáp ứng được nhu cầu, bạn có thể xem thêm các chủ đề khác về việc nối nhiều tập tin excel thành 1 như sau:
- Nối Sheet 1 hoặc Sheet 2,3,4,... của nhiều tập tin excel thành một tập tin duy nhât.
- Nối nhiều tập tin excel có nhiều sheet thành một sheet duy nhất trong 1 tập tin excel duy nhất.
- Nối các Sheet của nhiều tập tin excel thành 1 tập tin excel duy nhất tương ứng với các Sheet của các tập tin excel được gom.
Chúc các bạn thành công, nếu bài viết hữu ích hãy like và comments gì đó nha ^^! nó tạo cho mình có thêm động lực viết bài ^^!
Write: +Bui Ngoc Son
No comments:
Post a Comment