Giúp làm Marco để gộp tất cả các sheet của nhiều file khác nhau thành 1 file 1 sheet (3 người xem)

[dynamic503]

Xxin lỗi em làm cái tiêu đề không đúng lắm, nhu cầu của em là thế này ạ:
Tình hình là em có các file excel trong 1 thư mục c:\test (Nhiều loại có đuôi là .csv, .xls, .xlsx)
Bầy giờ em muốn làm một cái nút lệnh (trong file mới, VD file

 

[Quang_Hải]

Xxin lỗi em làm cái tiêu đề không đúng lắm, nhu cầu của em là thế này ạ:
Tình hình là em có các file excel trong 1 thư mục c:\test (Nhiều loại có đuôi là .csv, .xls, .xlsx)
Bầy giờ em muốn làm một cái nút lệnh (trong file mới, VD file "tonghop.xlsx") gom tất cả các sheet của tất cả các file trong thư mục đó thành 1 sheet mới có tên là "data tong hop" ( chứa data của tất cả các sheet trong các file khác nhau)
Xin chân thành cảm ơn

Sub MergeFies()
    Dim FilesToOpen, X As Integer, sh As Worksheet
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False
    FilesToOpen = Application.GetOpenFilename _
      ("All Excel Files, *.xls?*", MultiSelect:=True, Title:="Files to Merge")
    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
        GoTo ExitHandler
    End If
    X = 1
    While X <= UBound(FilesToOpen)
        Workbooks.Open Filename:=FilesToOpen(X)
        With ActiveWorkbook
        For Each sh In .Worksheets
            If sh.UsedRange.Rows.Count > 1 Then
                sh.UsedRange.Copy ThisWorkbook.Sheets("sheet1").[A65536].End(3).Offset(1)
            End If
        Next
        .Close False
        End With
        X = X + 1
    Wend
ExitHandler:
    Application.ScreenUpdating = True
    Exit Sub
ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub

 

[dynamic503]

Sub MergeFies()
    Dim FilesToOpen, X As Integer, sh As Worksheet
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False
    FilesToOpen = Application.GetOpenFilename _
      (

 

[Quang_Hải]

Sửa lại vầy coi sao. Chú ý câu lệnh CurWB.Sheets("sheet1"). Sửa lại chữ màu đỏ cho đúng tên sheet của bạn

Sub MergeFies()
    Dim FilesToOpen, X As Integer, sh As Worksheet, CurWB As Workbook
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False
    FilesToOpen = Application.GetOpenFilename _
      ("All Excel Files, *.xls?*", MultiSelect:=True, Title:="Files to Merge")
    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
        GoTo ExitHandler
    End If
    Set CurWB = ThisWorkbook
    X = 1
    While X <= UBound(FilesToOpen)
        Workbooks.Open Filename:=FilesToOpen(X)
        With ActiveWorkbook
        For Each sh In .Worksheets
            If sh.UsedRange.Rows.Count > 1 Then
                sh.UsedRange.Copy CurWB.Sheets("sheet1").[A65536].End(3).Offset(1)
            End If
        Next
        .Close False
        End With
        X = X + 1
    Wend
ExitHandler:
    Application.ScreenUpdating = True
    Exit Sub
ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub

 

[dynamic503]

Bác ơi trong thư mục em có gần 400 file, mà code này nó chạy chậm quá phải hơn 6 phút mới xong, có code nào nhanh hơn nữa không bác?

 

[ndu96081631]

Bác ơi trong thư mục em có gần 400 file, mà code này nó chạy chậm quá phải hơn 6 phút mới xong, có code nào nhanh hơn nữa không bác?

Code mở file trực tiếp rồi copy đương nhiên phải chậm rồi
Bạn thử tìm trên diễn đàn giải pháp ADO xem

 

[Quang_Hải]

Bác ơi trong thư mục em có gần 400 file, mà code này nó chạy chậm quá phải hơn 6 phút mới xong, có code nào nhanh hơn nữa không bác?

Bấm nút cái rồi đi pha cà phê uống. Chỉ copy 1 lần chứ bộ ngày nào cũng gộp file sao?

 

[dynamic503]

Bấm nút cái rồi đi pha cà phê uống. Chỉ copy 1 lần chứ bộ ngày nào cũng gộp file sao?

bác nói chỉ có đúng, 1 tháng 1 lần bác ạ, nhưng nếu bác biết cách nào nhanh hơn thì chỉ giùm em nhé!

 

[tranvanhung2009]

Sửa lại vầy coi sao. Chú ý câu lệnh CurWB.Sheets("sheet1"). Sửa lại chữ màu đỏ cho đúng tên sheet của bạn

Sub MergeFies()
    Dim FilesToOpen, X As Integer, sh As Worksheet, CurWB As Workbook
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False
    FilesToOpen = Application.GetOpenFilename _
      ("All Excel Files, *.xls?*", MultiSelect:=True, Title:="Files to Merge")
    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
        GoTo ExitHandler
    End If
    Set CurWB = ThisWorkbook
    X = 1
    While X <= UBound(FilesToOpen)
        Workbooks.Open Filename:=FilesToOpen(X)
        With ActiveWorkbook
        For Each sh In .Worksheets
            If sh.UsedRange.Rows.Count > 1 Then
                sh.UsedRange.Copy CurWB.Sheets("sheet1").[A65536].End(3).Offset(1)
            End If
        Next
        .Close False
        End With
        X = X + 1
    Wend
ExitHandler:
    Application.ScreenUpdating = True
    Exit Sub
ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub

Thầy ơi, em có nhiều file *CSV, em muốn gộp vào trong 1 book, mỗi 1 file csv thì thành 1 sheet , tên file CSV thanh tên của sheet trong book đó thì code viết như thế nào vậy thầy???

 

[Lequocvan]

http://www.giaiphapexcel.com/forum/...ều-sheet-trong-1-một-book&p=599347#post599347