Trường hợp 1: Tìm & tổng hợp số liệu từ nhiều file về 1 file ; Trường hợp 2: từ 1 file se số liệu cho nhiều file theo 1 số điều kiện

[AnhThu-1976]

Em chào các Thầy Cô, Anh Chị & các bạn!
Công việc mới em hiện nay là
Trường hợp 1: Tìm & tổng hợp số liệu từ nhiều file về 1 file , nghĩa là lấy số liệu từ các file do các cửa hàng gởi về vào 1 file Tonghop

Trường hợp 2: từ 1 file em se số liệu cho nhiều file, nghĩa là từ 1 file Tonghop em sẽ chuyển số liệu sang các file cửa hàng

Em ví dụ:
1/ Giả sử em có 3 file cửa hàng , trong file này có nhiều sheet, nhưng sheet cần lấy hay se số liệu là sheet TON, trong sheet TON này thì cột B chứa mã cửa hàng, cột D là mã hàng hóa còn cột E và F là dùng lấy hay se số liệu từ file Tonghop

2/ Và 1 file Tên Tonghop, file này dùng để tổng hợp số liệu từ các file cửa hàng vào hay chia sẻ số liệu cho các file cửa hàng, tên sheet là tương ứng với từng mã cửa hàng của các file cửa hàng (ở sheet TON, cột B)

3/ Tất cả 4 file trên em để trong 1 floder
4/ Lưu ý cả 2 trường hợp trên là số file cửa hàng có thể ít hơn số sheet ở file Tonghop
*******************
Xét trường hợp 1: Mỗi ngày các cửa hàng sẽ gởi file về cho em, em sẽ đưa tất cả vào 1 floder, em muốn chạy code để từng file cửa hàng, lấy số liệu các các file cửa hàng từ sheet TON và đưa vào file TongHop theo tên sheet giống như mã cửa hàng (ở cột B-sheet TON), lưu ý là lấy đúng theo mã hàng hóa

Xét trường hợp 2: từ 1 file em se số liệu cho nhiều file, nghĩa là từ 1 file Tonghop em sẽ chuyển số liệu sang các file cửa hàng;
cũng như trên tất cả các file em đưa vào 1 floder, em muốn chạy code để từ file của cửa hàng dựa vào mã cửa hàng ở cột B - sheet TON, thì sẽ lấy số liệu từ file Tonghop của sheet nào có tên tương ứng với mã cửa hàng, lưu ý là lấy đúng theo mã hàng hóa


Vì đây là công việc hàng ngày và thường xuyên (số lượng của hàng khoảng hơn 20 cái) em phải dủng hàm VLOOKUP để lấy số liệu, em mong các các Thầy Cô, Anh Chị & các bạn giúp em các đoạn code cho cả 2 trường hợp trên, em đã tìm trên GPE nhưng không có bài tương tự. Em xin cảm ơn!

 

[AnhThu-1976]

Em xin bổ sung thêm: Vì số lượng file các cửa hàng có thể ít hơn hoặc bằng số lượng sheet ở file Tonghop, nên em nghĩ trong floder chỉ để các file cửa hàng, còn code sẽ để trong file Tonghop, code sẽ duyệt qua từng file để đưa số liệu lên hay lấy số liệu về
code chọn floder và mở từng file thì em có (sưu tầm), trên đây chỉ là ý của em, anh chị làm theo cách mà anh chị thấy thuận lợi ạ!

 

[ptm0412]

File TongHop không thấy sheet tổng hợp và cũng không thấy "code chọn folder và mở từng file"

 

[AnhThu-1976]

File TongHop không thấy sheet tổng hợp và cũng không thấy "code chọn folder và mở từng file"

Dạ trong file Tonghop thì mỗi sheet sẽ lấy số liệu của từng file của từng cửa hàng, chứ không có sheet Tonghop
Còn code chọn floder mà mở từng file là

Sub MoFloder()
    Dim fso As Object
    Dim xFd As FileDialog
    Dim xFile As Variant
    Dim sType As String
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        For Each xFile In fso.GetFolder(xFd.SelectedItems(1)).Files
            sType = fso.GetFile(xFile).Type
            If sType Like "Microsoft Excel*Worksheet" Then
                With Workbooks.Open(xFile.Path)

                    '*************
                    'your code here
                    '***********************
                End With
            End If
        Next
    End If
End Sub

 

[ptm0412]

Dạ trong file Tonghop thì mỗi sheet sẽ lấy số liệu của từng file của từng cửa hàng, chứ không có sheet Tonghop
Còn code chọn floder...

Folder chứ không phải floder nhé.
Code trường hợp 1 viết đơn giản cho dễ hiểu. Bài này có thể dùng mảng, ADO, Power query đều được.

Sub CopyFile()
Application.ScreenUpdating = False
    Dim fso As Object
    Dim xFd As FileDialog
    Dim xFile As Variant
    Dim sType As String
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    Dim LastRw As Long, SheetName As String
    If xFd.Show = -1 Then
        For Each xFile In fso.GetFolder(xFd.SelectedItems(1)).Files
            sType = fso.GetFile(xFile).Type
            If sType Like "Microsoft Excel*Worksheet" And _
             Not xFile.Name Like "*" & ThisWorkbook.Name Then
                With Workbooks.Open(xFile.Path)
                    With ActiveWorkbook.Sheets("TON")
                        LastRw = .Range("A10000").End(xlUp).Row
                        SheetName = .Range("B2").Value
                        ThisWorkbook.Sheets(SheetName).Range("A4:C10000").ClearContents
                        .Range("D2:F" & LastRw).Copy ThisWorkbook.Sheets(SheetName).Range("A4")
                    End With
                    .Close False
                End With
            End If
        Next
    End If
Application.ScreenUpdating = True
End Sub

 

[AnhThu-1976]

Folder chứ không phải floder nhé.
Code trường hợp 1 viết đơn giản cho dễ hiểu. Bài này có thể dùng mảng, ADO, Power query đều được.

Dạ em cảm ơn Thầy nhiều!
Thầy hay các anh chị giúp em thêm trường hợp 2 ạ!

 

[ptm0412]

Dạ em cảm ơn Thầy nhiều!
Thầy hay các anh chị giúp em thêm trường hợp 2 ạ!

Trường hợp 2:
- Copy các sheet vào folder D:\Share, nếu không thì sửa giá trị FilePath
- Tạo 1 sheet Sample chỉ chứa tiêu đề mẫu như hình

Sub SaveBranchs()
Dim Sh As Worksheet, LastRw As Long, FileName As String
Dim StoreName As String, StoreCode As String, ShareDate As Date, Data(), DataCount
Const FilePath = "D:\Share\"
Application.ScreenUpdating = False
For Each Sh In ThisWorkbook.Sheets
    If Sh.Name <> "Sample" Then
        With Sh
            FileName = .Cells(1, 2) & "-" & Format(Date, "dd-mm-yyyy") & ".xlsx"
            StoreName = .Cells(1, 1)
            StoreCode = .Cells(1, 2)
            LastRw = .Cells(10000, 1).End(xlUp).Row
            ShareDate = Date
            DataCount = LastRw - 3
        End With
        Workbooks.Add
        With ActiveWorkbook.ActiveSheet
            ThisWorkbook.Sheets("Sample").[A1:F1].Copy .[A1]
            Sh.Range("A4:C" & LastRw).Copy .[D2]
            .Cells(2, 1).Resize(DataCount, 1) = ShareDate
            .Cells(2, 2).Resize(DataCount, 1) = StoreCode
            .Cells(2, 3).Resize(DataCount, 1) = StoreName
            .Range("A:F").Columns.AutoFit
            .Range("A2").Resize(DataCount, 6).Borders.LineStyle = 1
        End With
        ActiveWorkbook.SaveAs FilePath & FileName, xlOpenXMLWorkbook
        ActiveWorkbook.Close
    End If
Next
Application.ScreenUpdating = True
End Sub

 

[ptm0412]

Trường hợp 2: nếu mở file và cập nhật vào file cũ vào bên dưới dữ liệu gốc thì dùng code này. Nếu ghi đè thì thêm dòng code xoá cũ trên dòng code giá trị NextRw

Sub CopyToBranchs()
Application.ScreenUpdating = False
    Dim fso As Object, xFd As FileDialog
    Dim xFile As Variant, sType As String, DataCount As String
    Dim NextRw As Long, LastRwData As Long, SheetName As String, Sh As Worksheet
    Dim StoreName As String, StoreCode As String, ShareDate As Date
   
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        For Each xFile In fso.GetFolder(xFd.SelectedItems(1)).Files
            sType = fso.GetFile(xFile).Type
            If sType Like "Microsoft Excel*Worksheet" And _
             Not xFile.Name Like "*" & ThisWorkbook.Name Then
                With Workbooks.Open(xFile.Path)
                    With ActiveWorkbook.Sheets("TON")
                        SheetName = .Range("B2").Value
                        NextRw = .Range("A10000").End(xlUp).Row + 1                        
                        Set Sh = ThisWorkbook.Sheets(SheetName)
                        StoreName = Sh.Cells(1, 1)
                        StoreCode = CStr(Sh.Cells(1, 2))
                        ShareDate = Date
                        LastRwData = Sh.Cells(1000, 1).End(xlUp).Row
                        DataCount = LastRwData - 3
                        Sh.Range("A4").Resize(DataCount, 3).Copy .Cells(NextRw, 4)
                        .Cells(NextRw, 1).Resize(DataCount, 1) = ShareDate
                        .Cells(NextRw, 2).Resize(DataCount, 1).NumberFormat = "@"
                        .Cells(NextRw, 2).Resize(DataCount, 1) = StoreCode
                        .Cells(NextRw, 3).Resize(DataCount, 1) = StoreName
                        .Cells(NextRw, 1).Resize(DataCount, 6).Borders.LineStyle = 1
                    End With
                    .Close True
                End With
            End If
        Next
    End If
Application.ScreenUpdating = True
End Sub

 

[AnhThu-1976]

Trường hợp 2: nếu mở file và cập nhật vào file cũ vào bên dưới dữ liệu gốc thì dùng code này. Nếu ghi đè thì thêm dòng code xoá cũ trên dòng code giá trị NextRw

Sang năm mới Chúc Gia Đình Thầy nhiều sức khỏe, làm ăn phát tài,AN KHANG – THỊNH VƯỢNG!
Em cảm ơn Thầy nhiều!

 

[AnhThu-1976]

Dạ cho em hỏi ở bài số 8 là

Set Sh = ThisWorkbook.Sheets(SheetName)

Ở trên là có tồn tại
Còn trường hợp Có file cửa hàng nhưng trong file Tonghop không có sheet mang mã cửa hàng thì em muốn nó báo
MsgBox " khong co sheet cua hang" thì em cần sửa code trên như thế nào?
Em cảm ơn!

 

[ptm0412]

trường hợp Có file cửa hàng nhưng trong file Tonghop không có sheet mang mã cửa hàng

Thêm mấy dòng lệnh kiểm tra sự tồn tại, nếu không tồn tại thì thông báo, đóng file không lưu và chạy tiếp cho các file khác.

Sub CopyToBranchs()
Application.ScreenUpdating = False
    Dim fso As Object, xFd As FileDialog, Sh1 As Worksheet, SheetExisted As Boolean
    Dim xFile As Variant, sType As String, DataCount As String
    Dim NextRw As Long, LastRwData As Long, SheetName As String, Sh As Worksheet
    Dim StoreName As String, StoreCode As String, ShareDate As Date
  
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        For Each xFile In fso.GetFolder(xFd.SelectedItems(1)).Files
            SheetExisted = False
            sType = fso.GetFile(xFile).Type
            If sType Like "Microsoft Excel*Worksheet" And _
             Not xFile.Name Like "*" & ThisWorkbook.Name Then
                With Workbooks.Open(xFile.Path)
                    With ActiveWorkbook.Sheets("TON")
                        SheetName = .Range("B2").Value
                        .Range(.Cells(2, 6), .Cells(10000, 1).End(xlUp)).Clear 'Over write'
                        NextRw = .Range("A10000").End(xlUp).Row + 1
                        For Each Sh1 In ThisWorkbook.Sheets
                            If Sh1.Name = SheetName Then
                                Set Sh = ThisWorkbook.Sheets(SheetName)
                                SheetExisted = True
                                Exit For
                            End If
                        Next
                        If SheetExisted = False Then
                            MsgBox "There is no sheet named " & SheetName, , "Ptm0412"
                            .Parent.Close False
                            GoTo NextxFile
                        Else
                            StoreName = Sh.Cells(1, 1)
                            StoreCode = CStr(Sh.Cells(1, 2))
                            ShareDate = Date
                            LastRwData = Sh.Cells(1000, 1).End(xlUp).Row
                            DataCount = LastRwData - 3
                            Sh.Range("A4").Resize(DataCount, 3).Copy .Cells(NextRw, 4)
                            .Cells(NextRw, 1).Resize(DataCount, 1) = ShareDate
                            .Cells(NextRw, 2).Resize(DataCount, 1).NumberFormat = "@"
                            .Cells(NextRw, 2).Resize(DataCount, 1) = StoreCode
                            .Cells(NextRw, 3).Resize(DataCount, 1) = StoreName
                            .Cells(NextRw, 1).Resize(DataCount, 6).Borders.LineStyle = 1
                        End If
                    End With
                    .Close True
                End With
            End If
NextxFile:
        Next
    End If
MsgBox "Done", , "Ptm0412"
Application.ScreenUpdating = True
End Sub