Append dữ liệu (1 người xem)

[thephuonglamvo]

Các anh ơi giúp tôi với.
Tôi có 1400 file dữ liệu Excel có cấu trúc giống nhau (do bộ phận khác cập nhật), nay tôi cần copy thành 1 file duy nhất để tạo thành 1 CSDL để sử dụng nhưng không thể mở tất cả các file rồi copy vì rất mất thời gian, khó cập nhật lại khi có thay đổi.
Các anh có cách nào giúp tôi dùng VB để mở các file gốc rồi append dữ liệu vào 1 file nào đó để sử dụng.Xin cảm ơn nhiều.

 

[nvson]

Hỏi: Xin hướng dẫn viết hàm VB để thực hiện tổng hợp 800 file Excel nằm trên các thư mục khác nhau thành 1 file duy nhất.
Đáp:
Ý tưởng dồn hàng trăm file độc lập thành 1 file duy nhất là không hay, ngược với cách quản lý khoa học thông thường. Thực tế, để quản lý thông tin lớn, người ta thường chia nhỏ nó ra thành nhiều phần và chứa chúng lên nhiều file độc lập nhau, mỗi lần cần xử lý thành phần nào thì chỉ mở file tương ứng chứ không cần đụng chạm tới các file còn lại.
.......

Nhưng nếu bạn muốn thì sử dụng code sau:

Sub Example5()
Dim basebook As Workbook
Dim mybook As Workbook
Dim SourceRange As Range
Dim DestRange As Range
Dim SourceRcount As Long
Dim n As Long, i As Long
Dim rnum As Long
Dim MyPath As String
Dim SaveDriveDir As String
Dim FName As Variant
SaveDriveDir = CurDir
MyPath = "D:\"
ChDrive MyPath
ChDir MyPath
FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xls), *.xls", MultiSelect:=True)
If IsArray(FName) Then
    Application.ScreenUpdating = False
    Set basebook = ActiveWorkbook
    rnum = 1
 
    For n = LBound(FName) To UBound(FName)
        Set mybook = Workbooks.Open(FName(n))
 
        'Day chinh la vung ma ban can copy (Vung A10:E20 trong sheet co ten la CSDL)
        Set SourceRange = mybook.Worksheets("[B][COLOR=red]CSDL[/COLOR][/B]").Range("[COLOR=red][B]A10:E20[/B][/COLOR]")
        SourceRcount = SourceRange.Rows.Count
        Set DestRange = basebook.Worksheets("[COLOR=red][B]CSDL[/B][/COLOR]").Cells(rnum, "A")
 
        With SourceRange
            Set DestRange = basebook.Worksheets("[COLOR=red][B]CSDL[/B][/COLOR]").Cells(rnum, "A").Resize(.Rows.Count, .Columns.Count)
        End With
        DestRange.Value = SourceRange.Value
 
        'Dong file
        mybook.Close False
 
        rnum = rnum + SourceRcount
    Next n
End If
'Tra ve mac dinh truoc khi mo
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub

Bạn hãy thay đổi phần chữ đỏ cho phù hợp với bài toán của bạn!
Bạn tham khảo thêm ở đây nhé