Add-Ins ghép nhiều file Excel thành 1 file duy nhất

Liên hệ QC
T

thinh18tt

Thành viên mới
Tham gia
21/1/10
Bài viết
13
Được thích
23
Chào các bạn;

Do nhu cầu công việc nên mình tạo 1 Add-Ins để ghép nhiều file Excel thành 1 file duy nhất. Tiện thể chia sẻ cho anh em dùng và góp ý.

Tạo Add-Ins có cái hay là chỉ cần nạp 1 lần và sử dụng mãi mãi.

Yêu cầu:
- Office 2007 trở lên
- Các File cần ghép có cấu trúc giống hệt nhau
- Dữ liệu nằm ở Sheet đầu tiên (không phân biệt tên Sheet)
- Chỉ hoạt động khi bạn chọn từ 2 file trở lên (vì 1 file thì cần gì ghép nữa --=0)

Mô tả:
- Chương trình sẽ ghép tất cả các File đã chọn thành 1 File duy nhất tại thư mục chứa các File đang chọn và có tên là "Tong hop ddmmyyyy hhmmss.xlsx"
- Khi chọn xong các File, chương trình đọc lần lượt từng File. Với File đầu tiên thì sẽ Copy toàn bộ dữ liệu, các file tiếp theo sẽ copy dữ liệu từ hàng thứ 2.
- Khi xong chương trình tự lưu lại.

Note: Mình để Open Source để các bạn muốn thì tham khảo và góp ý.
 

File đính kèm

  • Joint Excels.xlam
    25.1 KB · Đọc: 4,054
thinh18tt đã viết:
Chào các bạn;

Do nhu cầu công việc nên mình tạo 1 Add-Ins để ghép nhiều file Excel thành 1 file duy nhất. Tiện thể chia sẻ cho anh em dùng và góp ý.

Tạo Add-Ins có cái hay là chỉ cần nạp 1 lần và sử dụng mãi mãi.

Yêu cầu:
- Office 2007 trở lên
- Các File cần ghép có cấu trúc giống hệt nhau
- Dữ liệu nằm ở Sheet đầu tiên (không phân biệt tên Sheet)
- Chỉ hoạt động khi bạn chọn từ 2 file trở lên (vì 1 file thì cần gì ghép nữa --=0)

Mô tả:
- Chương trình sẽ ghép tất cả các File đã chọn thành 1 File duy nhất tại thư mục chứa các File đang chọn và có tên là "Tong hop ddmmyyyy hhmmss.xlsx"
- Khi chọn xong các File, chương trình đọc lần lượt từng File. Với File đầu tiên thì sẽ Copy toàn bộ dữ liệu, các file tiếp theo sẽ copy dữ liệu từ hàng thứ 2.
- Khi xong chương trình tự lưu lại.

Note: Mình để Open Source để các bạn muốn thì tham khảo và góp ý.
Nhấp chuột vào đây để mở rộng...

Do mình muốn gộp các file vào một file đã tạo sẵn nên mình muốn ctrinh vẫn hoạt động trong trường hợp chọn 1 file.
Bạn có thể giúp mình sửa code được không?
 

File đính kèm

  • JOINT DATA.xlsm
    29.1 KB · Đọc: 597
kdang đã viết:
Do mình muốn gộp các file vào một file đã tạo sẵn nên mình muốn ctrinh vẫn hoạt động trong trường hợp chọn 1 file.
Bạn có thể giúp mình sửa code được không?
Nhấp chuột vào đây để mở rộng...
Đang không khỏe nhưng cũng cố chọt chọt bàn phím thế này
PHP: 
Sub MergeFie()
    Dim Y, X As Integer, sh As Worksheet, Cursh As Worksheet
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False
    Set Cursh = ActiveSheet
    Y = Application.GetOpenFilename("Excel Files, *.xls?*", MultiSelect:=True)
    If TypeName(Y) = "Boolean" Then
        MsgBox "No Files were selected"
        GoTo ExitHandler
    End If
    X = 1
    While X <= UBound(Y)
        Workbooks.Open Y(X)
        With ActiveWorkbook
            For Each sh In .Worksheets
                If sh.UsedRange.Rows.Count > 1 Then
                    sh.UsedRange.Offset(1).Copy
                    Cursh.[A65536].End(3)(2).PasteSpecial 3
                End If
            Next
            Application.CutCopyMode = False
            .Close False
        End With
        X = X + 1
    Wend
ExitHandler:
    Application.ScreenUpdating = True
    Exit Sub
ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub
 
Có cao thủ nào giúp em với: em sử dụng code ghép file excel của thinh18tt nhưng nó báo lỗi như bên dưới:

Sub AUTO_OPEN()
GhepExcelFile
End Sub
Sub GhepExcelFile()
Dim sFileName As String
Dim ArrFile() As String
Dim i As Integer
Dim DirLog As String
Dim MaxCol As Long
Dim MaxRow As Long
Dim bHeader As Boolean
Dim OutputFile As String
bHeader = False
On Error Resume Next
Windows("Data.xlsx").Activate
ActiveWorkbook.Save
Workbooks("data.xlsx").Close
On Error GoTo 0
If ShowOpen(sFileName, , "Excel Files (*.xls;*.xlsx)|*.xls;*.xlsx", , , , , OFN_ALLOWMULTiSELECT Or OFN_EXPLORER) Then
ArrFile = Split(sFileName, "|")
DirLog = ArrFile(LBound(ArrFile)) & "\"

If UBound(ArrFile) > 0 Then
'OutputFile = "Tong hop " & Format(Now(), "ddmmyyyy hhmmss") & ".xlsx"
'Workbooks.Add
'ChDir DirLog
'ActiveWorkbook.SaveAs Filename:=DirLog & OutputFile
On Error Resume Next
Workbooks.Open "D:\chuyen luong\data.xlsx"
On Error GoTo 0
For i = LBound(ArrFile) + 1 To UBound(ArrFile)
Workbooks.Open DirLog & ArrFile(i)
MaxRow = ActiveSheet.UsedRange.Rows.Count
MaxCol = ActiveSheet.UsedRange.Columns.Count
If bHeader = False Then
Range(Cells(1, 1).Address & ":" & Cells(MaxRow, MaxCol).Address).Select
bHeader = True
Else
Range(Cells(2, 1).Address & ":" & Cells(MaxRow, MaxCol).Address).Select
End If
Selection.Copy
Windows("Data.xlsx").Activate
MaxRow = ActiveSheet.UsedRange.Rows.Count
If MaxRow = 1 Then
Range("A1").Select
Else
Range("A" & (MaxRow + 1)).Select
End If
ActiveSheet.Paste
Application.CutCopyMode = False
Workbooks(ArrFile(i)).Close
Next i
Columns("c:f").Delete
ActiveSheet.Range("$A$1:$B$1000000").RemoveDuplicates Columns:=Array(1, 2), _
Header:=xlNo
Range("A2:A1000000").Select
On Error Resume Next
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
Columns("A:B").Select
With Selection
.Font.Bold = False
.Font.Size = 10
.Font.Name = "times new roman"
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
'ActiveSheet.Range("a1:b1000000").REMOVEDUPLICATE
ActiveWorkbook.Save
Workbooks("data.xlsx").Close
End If
End If
End Sub
 
Cảm ơn bạn, joint rất hay, bạn có thể sửa code theo tiêu chí này được không (từ ofice 2003-2013).
1/ Gộp nhiều file excel thành 01 file và mỗi file 1 sheet đã cố định (Không lấy các sheet bên cạnh).
2/ Tách nhiều sheet của 01 file thành nhiều file, mỗi sheet 01 file.
Cảm ơn cao thủ trước nhé.
 
3/ Gộp nhiều sheet trong 01 file thành 01 sheet duy nhất.
 
chuducninh đã viết:
Có cao thủ nào giúp em với: em sử dụng code ghép file excel của thinh18tt nhưng nó báo lỗi như bên dưới:

Sub AUTO_OPEN()
GhepExcelFile
End Sub
Sub GhepExcelFile()
Dim sFileName As String
Dim ArrFile() As String
Dim i As Integer
Dim DirLog As String
Dim MaxCol As Long
Dim MaxRow As Long
Dim bHeader As Boolean
Dim OutputFile As String
bHeader = False
On Error Resume Next
Windows("Data.xlsx").Activate
ActiveWorkbook.Save
Workbooks("data.xlsx").Close
On Error GoTo 0
If ShowOpen(sFileName, , "Excel Files (*.xls;*.xlsx)|*.xls;*.xlsx", , , , , OFN_ALLOWMULTiSELECT Or OFN_EXPLORER) Then
ArrFile = Split(sFileName, "|")
DirLog = ArrFile(LBound(ArrFile)) & "\"

If UBound(ArrFile) > 0 Then
'OutputFile = "Tong hop " & Format(Now(), "ddmmyyyy hhmmss") & ".xlsx"
'Workbooks.Add
'ChDir DirLog
'ActiveWorkbook.SaveAs Filename:=DirLog & OutputFile
On Error Resume Next
Workbooks.Open "D:\chuyen luong\data.xlsx"
On Error GoTo 0
For i = LBound(ArrFile) + 1 To UBound(ArrFile)
Workbooks.Open DirLog & ArrFile(i)
MaxRow = ActiveSheet.UsedRange.Rows.Count
MaxCol = ActiveSheet.UsedRange.Columns.Count
If bHeader = False Then
Range(Cells(1, 1).Address & ":" & Cells(MaxRow, MaxCol).Address).Select
bHeader = True
Else
Range(Cells(2, 1).Address & ":" & Cells(MaxRow, MaxCol).Address).Select
End If
Selection.Copy
Windows("Data.xlsx").Activate
MaxRow = ActiveSheet.UsedRange.Rows.Count
If MaxRow = 1 Then
Range("A1").Select
Else
Range("A" & (MaxRow + 1)).Select
End If
ActiveSheet.Paste
Application.CutCopyMode = False
Workbooks(ArrFile(i)).Close
Next i
Columns("c:f").Delete
ActiveSheet.Range("$A$1:$B$1000000").RemoveDuplicates Columns:=Array(1, 2), _
Header:=xlNo
Range("A2:A1000000").Select
On Error Resume Next
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
Columns("A:B").Select
With Selection
.Font.Bold = False
.Font.Size = 10
.Font.Name = "times new roman"
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
'ActiveSheet.Range("a1:b1000000").REMOVEDUPLICATE
ActiveWorkbook.Save
Workbooks("data.xlsx").Close
End If
End If
End Sub
Nhấp chuột vào đây để mở rộng...
Bạn dùng file gốc của bạn thinh18tt nhé. code trên là file Jointdata mà mình đã sửa code để dùng gộp các file mình cần làm.
 
Cám ơn tác giả rất nhiều. Cho mình hỏi thêm, nếu mình muốn join từ sheet 2 (ko phải join sheet 1) thì sao? VÌ hàng tháng mình cần join khoảng 30 file, mỗi file có 5 sheet, nhưng mình chỉ cần join sheet thứ hai mà thôi.
Tks again!
 
dexem đã viết:
Cám ơn tác giả rất nhiều. Cho mình hỏi thêm, nếu mình muốn join từ sheet 2 (ko phải join sheet 1) thì sao? VÌ hàng tháng mình cần join khoảng 30 file, mỗi file có 5 sheet, nhưng mình chỉ cần join sheet thứ hai mà thôi.
Tks again!
Nhấp chuột vào đây để mở rộng...
sheet 2 ở đây là:
1/ sheet.name = "sheet 2" (Tức là cái tên của worksheet mà bạn nhìn thấy ở tab sheet)
2/ (Name) = Sheet 2 (Properties của worksheet trong VBA)
 
Cám ơn tác giả, mình đã joint thành công sheet 2.
 
Cho em hỏi có thể thêm được 1 cột nữa để hiển thị tên tên file đã ghép vào mỗi hàng được không, vì ghép nhiều quá không biết dòng nào của file nào?
 
Office 64bit

Trên nền 32Bit thì ok, còn 64 bit bị báo lỗi bạn ơi !!!
 
thinh18tt đã viết:
Chào các bạn;

Do nhu cầu công việc nên mình tạo 1 Add-Ins để ghép nhiều file Excel thành 1 file duy nhất. Tiện thể chia sẻ cho anh em dùng và góp ý.

Tạo Add-Ins có cái hay là chỉ cần nạp 1 lần và sử dụng mãi mãi.

Yêu cầu:
- Office 2007 trở lên
- Các File cần ghép có cấu trúc giống hệt nhau
- Dữ liệu nằm ở Sheet đầu tiên (không phân biệt tên Sheet)
- Chỉ hoạt động khi bạn chọn từ 2 file trở lên (vì 1 file thì cần gì ghép nữa --=0)

Mô tả:
- Chương trình sẽ ghép tất cả các File đã chọn thành 1 File duy nhất tại thư mục chứa các File đang chọn và có tên là "Tong hop ddmmyyyy hhmmss.xlsx"
- Khi chọn xong các File, chương trình đọc lần lượt từng File. Với File đầu tiên thì sẽ Copy toàn bộ dữ liệu, các file tiếp theo sẽ copy dữ liệu từ hàng thứ 2.
- Khi xong chương trình tự lưu lại.

Note: Mình để Open Source để các bạn muốn thì tham khảo và góp ý.
Nhấp chuột vào đây để mở rộng...
File của bạn rất phù hợp với công việc của mình, nhưng khi mình ghép file thì có sự cố như sau:
1. File 1 mình có 207 dòng, file 2 có 126 dòng
Kết quả ghép lại có 275 dòng trống giữa file 1 và file 2
2. File có nhiều sheet như sheet "Ton Kho", "sheet 1", "sheet 2"...mình muốn ghép sheet "Ton Kho" của các file lại với nhau nhưng do mình Save dữ liệu tại "sheet 1" thì kết quả ghép bị sai. Bạn chỉnh giúp mình mặc định là ghép sheet "Ton Kho" nhé.
Cảm ơn bạn nhiều
 
thinh18tt đã viết:
Chào các bạn;

Do nhu cầu công việc nên mình tạo 1 Add-Ins để ghép nhiều file Excel thành 1 file duy nhất. Tiện thể chia sẻ cho anh em dùng và góp ý.

Tạo Add-Ins có cái hay là chỉ cần nạp 1 lần và sử dụng mãi mãi.

Yêu cầu:
- Office 2007 trở lên
- Các File cần ghép có cấu trúc giống hệt nhau
- Dữ liệu nằm ở Sheet đầu tiên (không phân biệt tên Sheet)
- Chỉ hoạt động khi bạn chọn từ 2 file trở lên (vì 1 file thì cần gì ghép nữa --=0)

Mô tả:
- Chương trình sẽ ghép tất cả các File đã chọn thành 1 File duy nhất tại thư mục chứa các File đang chọn và có tên là "Tong hop ddmmyyyy hhmmss.xlsx"
- Khi chọn xong các File, chương trình đọc lần lượt từng File. Với File đầu tiên thì sẽ Copy toàn bộ dữ liệu, các file tiếp theo sẽ copy dữ liệu từ hàng thứ 2.
- Khi xong chương trình tự lưu lại.

Note: Mình để Open Source để các bạn muốn thì tham khảo và góp ý.
Nhấp chuột vào đây để mở rộng...


File nay khong mo duoc tren 64bit 2013. aem co cach nao fix khong?
Thanks@ cntt.ptt@gmail.com
 
Lần chỉnh sửa cuối:
thinh18tt đã viết:
Chào các bạn;

Do nhu cầu công việc nên mình tạo 1 Add-Ins để ghép nhiều file Excel thành 1 file duy nhất. Tiện thể chia sẻ cho anh em dùng và góp ý.

Tạo Add-Ins có cái hay là chỉ cần nạp 1 lần và sử dụng mãi mãi.

Yêu cầu:
- Office 2007 trở lên
- Các File cần ghép có cấu trúc giống hệt nhau
- Dữ liệu nằm ở Sheet đầu tiên (không phân biệt tên Sheet)
- Chỉ hoạt động khi bạn chọn từ 2 file trở lên (vì 1 file thì cần gì ghép nữa --=0)

Mô tả:
- Chương trình sẽ ghép tất cả các File đã chọn thành 1 File duy nhất tại thư mục chứa các File đang chọn và có tên là "Tong hop ddmmyyyy hhmmss.xlsx"
- Khi chọn xong các File, chương trình đọc lần lượt từng File. Với File đầu tiên thì sẽ Copy toàn bộ dữ liệu, các file tiếp theo sẽ copy dữ liệu từ hàng thứ 2.
- Khi xong chương trình tự lưu lại.

Note: Mình để Open Source để các bạn muốn thì tham khảo và góp ý.
Nhấp chuột vào đây để mở rộng...


Minh mo bang office 2013 64bit thi bao loi. ad fix dum nhe. thanks@
 
Bac oi em dung thi co loi nay
Workbooks.Open DirLog & ArrFile(i)
Bac xem giup em voi
 
mình sử dụng office 2013 64 bit thì báo lỗi, add có thể fix giúp được không?
Mình có gửi đính kèm báo lỗi.
Thanks @
 

File đính kèm

  • Capture.jpg
    Capture.jpg
    38 KB · Đọc: 99
Mình chạy trên nền 64bit báo lỗi, pls help me
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

A
Excel thiếu dữ liệu
Trả lời
4
Đọc
115
Mr.hieudoanxd
Mr.hieudoanxd
H
  • Question
Code subtotal và tìm điều kiện
Trả lời
11
Đọc
195
Hoàng Tuấn 868
H
S
Nhờ giúp đỡ code in toàn bộ danh sách có điều kiện
Trả lời
1
Đọc
57
BuiQuangThuan
B
A
Đếm dữ liệu với điều kiện
Trả lời
11
Đọc
125
DeTong
D
Maika8008
  • Question
Add-In .xlam trộn dữ liệu Excel vào Word
    • Thích
    • Yêu thích
    • Cảm ơn
2
Trả lời
29
Đọc
2K
vu_tuan_manh_linh
vu_tuan_manh_linh
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom