Tách từ 1 vùng chỉ định trên file tổng ra các file con theo danh sách cửa hàng

[Excel my love_1]

Các anh, các chị và các bạn ơi! Hàng tháng em cần xuất ra các file con theo từng Cửa hàng từ file tổng để các cửa hàng kiểm tra và phản hồi
Em xin nhờ các anh, chị hỗ trợ code cho em để xuất ra các file con.
Chi tiết như sau:
[+1/]Em có File tổng theo dõi kinh phí công đoàn theo từng nhân viên của các cửa hàng, và cập nhập theo từng tháng (có tối đa 12 tháng) mỗi tháng khi thêm mới để cập nhập sẽ gồm 8 cột dàn ngang trên bảng tính (dự tính 1 năm bảng tính sẽ kết thúc ở cột CY). Hiện tại em đang cập nhập đến tháng 3. Khi sang tháng mới em sẽ tạo kỳ mới để cập nhập (Phần này em đã làm được). Xem ảnh minh họa


[+2] Trên file Tổng, Click vào Nút Kết Xuất File, có 1 userform hiện ra, nhập số tháng muốn kết xuất, (Phần này em đã làm được).
( vùng được lựa chọn em tạm xuất ra ô B1 và C1 trên sheet để các anh chị tiện sử dụng nếu cần nhé).
Sau khi chọn xong tháng trên Userform, người dùng Click tiếp OK Export File (đến đây thì em không biết code tiếp như thế nào ạ). Tiếp Em trình bày bằng hình ảnh để các anh chị tiện theo dõi mong muốn của em nhé:

Sau khi Click vào nút OK Export File trên Userform của File Tổng, code sẽ tạo ra các file con như hình tiếp đây ạ

Nội dung của các file con sẽ chính là kết quả của việc lọc các giá trị ở cột Cửa hàng tương ứng tại vùng tháng đã chọn trên file tổng ạ.
Ví dụ đây là hình ảnh nội dung của 1 file con của Theo dõi tháng 3 cửa hàng d được xuất từ file tổng ạ

Thao tác lọc từ file tổng để ra file con tháng 3 cửa hàng D như hình này ạ

Chi tiết em gửi file tổng và các file con đã làm ra kết quả thủ công
(Vì đơn vị em các nhân viên luân chuyển từ cửa hàng này sang cửa hàng kia nhiều và thường nghỉ việc đột xuất nên em cần theo dõi trên 1 file tổng để hàng hàng xuất file gửi Mail và yêu cầu từng cửa hàng thu tiền Công đoàn của các nhân viên theo danh sách)
Rất mong nhận được sự giúp đỡ của các anh chị

 

[Maika8008]

Các anh, các chị và các bạn ơi! Hàng tháng em cần xuất ra các file con theo từng Cửa hàng từ file tổng để các cửa hàng kiểm tra và phản hồi
Em xin nhờ các anh, chị hỗ trợ code cho em để xuất ra các file con.
Chi tiết như sau:
[+1/]Em có File tổng theo dõi kinh phí công đoàn theo từng nhân viên của các cửa hàng, và cập nhập theo từng tháng (có tối đa 12 tháng) mỗi tháng khi thêm mới để cập nhập sẽ gồm 8 cột dàn ngang trên bảng tính (dự tính 1 năm bảng tính sẽ kết thúc ở cột CY). Hiện tại em đang cập nhập đến tháng 3. Khi sang tháng mới em sẽ tạo kỳ mới để cập nhập (Phần này em đã làm được). Xem ảnh minh họa
View attachment 240042

[+2] Trên file Tổng, Click vào Nút Kết Xuất File, có 1 userform hiện ra, nhập số tháng muốn kết xuất, (Phần này em đã làm được).
( vùng được lựa chọn em tạm xuất ra ô B1 và C1 trên sheet để các anh chị tiện sử dụng nếu cần nhé).
Sau khi chọn xong tháng trên Userform, người dùng Click tiếp OK Export File (đến đây thì em không biết code tiếp như thế nào ạ). Tiếp Em trình bày bằng hình ảnh để các anh chị tiện theo dõi mong muốn của em nhé:
View attachment 240036
Sau khi Click vào nút OK Export File trên Userform của File Tổng, code sẽ tạo ra các file con như hình tiếp đây ạ
View attachment 240038
Nội dung của các file con sẽ chính là kết quả của việc lọc các giá trị ở cột Cửa hàng tương ứng tại vùng tháng đã chọn trên file tổng ạ.
Ví dụ đây là hình ảnh nội dung của 1 file con của Theo dõi tháng 3 cửa hàng d được xuất từ file tổng ạ
View attachment 240040
Thao tác lọc từ file tổng để ra file con tháng 3 cửa hàng D như hình này ạ
View attachment 240044
Chi tiết em gửi file tổng và các file con đã làm ra kết quả thủ công
(Vì đơn vị em các nhân viên luân chuyển từ cửa hàng này sang cửa hàng kia nhiều và thường nghỉ việc đột xuất nên em cần theo dõi trên 1 file tổng để hàng hàng xuất file gửi Mail và yêu cầu từng cửa hàng thu tiền Công đoàn của các nhân viên theo danh sách)
Rất mong nhận được sự giúp đỡ của các anh chị

Đọc đề bài cũng thấy mỏi.

 

[Excel my love_1]

Đọc đề bài cũng thấy mỏi.

Cảm ơn Maika8008 đã ngó qua bài của mình. Mình cũng thấy so với nhiều bài của 1 vài bạn mới tham gia GPE gần đây thì đúng là mình viết hơi dài. Nhưng nó xuất phát từ mong ước của mình là được các anh chị và các bạn hiểu đúng điều mình muốn thôi. Thật ra các anh chị lớn tuổi trên GPE có kinh nghiệm, các anh chị ấy có khi chỉ xem qua hình ảnh là đã nắm bắt vấn đề rồi ấy chứ bạn nhỉ

 

[giaiphap]

Các anh, các chị và các bạn ơi! Hàng tháng em cần xuất ra các file con theo từng Cửa hàng từ file tổng để các cửa hàng kiểm tra và phản hồi
Em xin nhờ các anh, chị hỗ trợ code cho em để xuất ra các file con.
Chi tiết như sau:
[+1/]Em có File tổng theo dõi kinh phí công đoàn theo từng nhân viên của các cửa hàng, và cập nhập theo từng tháng (có tối đa 12 tháng) mỗi tháng khi thêm mới để cập nhập sẽ gồm 8 cột dàn ngang trên bảng tính (dự tính 1 năm bảng tính sẽ kết thúc ở cột CY). Hiện tại em đang cập nhập đến tháng 3. Khi sang tháng mới em sẽ tạo kỳ mới để cập nhập (Phần này em đã làm được). Xem ảnh minh họa
View attachment 240042

[+2] Trên file Tổng, Click vào Nút Kết Xuất File, có 1 userform hiện ra, nhập số tháng muốn kết xuất, (Phần này em đã làm được).
( vùng được lựa chọn em tạm xuất ra ô B1 và C1 trên sheet để các anh chị tiện sử dụng nếu cần nhé).
Sau khi chọn xong tháng trên Userform, người dùng Click tiếp OK Export File (đến đây thì em không biết code tiếp như thế nào ạ). Tiếp Em trình bày bằng hình ảnh để các anh chị tiện theo dõi mong muốn của em nhé:
View attachment 240036
Sau khi Click vào nút OK Export File trên Userform của File Tổng, code sẽ tạo ra các file con như hình tiếp đây ạ
View attachment 240038
Nội dung của các file con sẽ chính là kết quả của việc lọc các giá trị ở cột Cửa hàng tương ứng tại vùng tháng đã chọn trên file tổng ạ.
Ví dụ đây là hình ảnh nội dung của 1 file con của Theo dõi tháng 3 cửa hàng d được xuất từ file tổng ạ
View attachment 240040
Thao tác lọc từ file tổng để ra file con tháng 3 cửa hàng D như hình này ạ
View attachment 240044
Chi tiết em gửi file tổng và các file con đã làm ra kết quả thủ công
(Vì đơn vị em các nhân viên luân chuyển từ cửa hàng này sang cửa hàng kia nhiều và thường nghỉ việc đột xuất nên em cần theo dõi trên 1 file tổng để hàng hàng xuất file gửi Mail và yêu cầu từng cửa hàng thu tiền Công đoàn của các nhân viên theo danh sách)
Rất mong nhận được sự giúp đỡ của các anh chị

Bỏ tất cả code có trong UserForm và thay bằng đoạn code dưới đây vào.

Option Explicit
Private Function RemoveDupesColl(MyArray As Variant) As Variant
    Dim i As Long
    Dim arrColl As New Collection
    Dim arrDummy() As Variant
    Dim arrDummy1() As Variant
    Dim item As Variant
    ReDim arrDummy1(LBound(MyArray) To UBound(MyArray))

    For i = LBound(MyArray) To UBound(MyArray) 'convert to string
        arrDummy1(i) = CStr(MyArray(i, 1))
    Next i
    On Error Resume Next
    For Each item In arrDummy1
       arrColl.Add item, item
    Next item
    Err.Clear
    ReDim arrDummy(LBound(MyArray) To arrColl.Count + LBound(MyArray) - 1)
    i = LBound(MyArray)
    For Each item In arrColl
       arrDummy(i) = item
       i = i + 1
    Next item
    RemoveDupesColl = arrDummy
End Function
Private Sub CommandButton1_Click()
Dim i%, j%, eValue%
Dim Wb As Workbook, NewWb As Workbook, Sh As Worksheet
Dim Arr, Path As String, eFile As String
Dim Rng As Range
Dim itemp
eValue = Val(UserForm4.TextBox1.Value)
If eValue > 3 Or eValue < 1 Then
    MsgBox "So ban nhap chua dung"
    Exit Sub
End If
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
    Path = ThisWorkbook.Path: eFile = ThisWorkbook.Name
    eFile = Left(eFile, Len(eFile) - 5)
    ActiveSheet.Copy
    j = 24 - eValue * 8
    Set Wb = ActiveWorkbook
    Set Sh = Wb.Sheets(1)
    With Sh
        If eValue <> 3 Then .Range("G:G").Offset(, eValue * 8 + 1).Resize(, j).EntireColumn.Delete
        .Range("D:D").Resize(, 4 + (eValue - 1) * 8).EntireColumn.Delete
        Set Rng = .Range("A3:K" & .[A65000].End(3).Row)
        Arr = RemoveDupesColl(Sh.Range("D4", Sh.[D65000].End(3)).Value)
        For Each itemp In Arr
            Set NewWb = Workbooks.Add
            Rng.AutoFilter 4, CStr(itemp)
            .Range("A1", Rng).SpecialCells(12).Copy
            With NewWb
                .Sheets(1).[A1].PasteSpecial xlPasteValues
                .Sheets(1).[A1].PasteSpecial xlPasteFormats
                .Sheets(1).Columns("A").Resize(, 11).AutoFit
                .SaveAs FileName:=Path & "\" & eFile & " - " & CStr(itemp) & "-" & UserForm4.TextBox1.Value & ".xlsx"
                .Close True
            End With
        Next itemp
    End With
    Wb.Close False
    Set Sh = Nothing
    Set NewWb = Nothing
    Set Wb = Nothing
Application.CutCopyMode = False
Application.DisplayAlerts = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Da thuc hien xong"
Unload Me
End Sub

Private Sub CommandButton2_Click()
    Unload Me
End Sub

 

[Excel my love_1]

Bỏ tất cả code có trong UserForm và thay bằng đoạn code dưới đây vào.

Option Explicit
Private Function RemoveDupesColl(MyArray As Variant) As Variant
    Dim i As Long
    Dim arrColl As New Collection
    Dim arrDummy() As Variant
    Dim arrDummy1() As Variant
    Dim item As Variant
    ReDim arrDummy1(LBound(MyArray) To UBound(MyArray))

    For i = LBound(MyArray) To UBound(MyArray) 'convert to string
        arrDummy1(i) = CStr(MyArray(i, 1))
    Next i
    On Error Resume Next
    For Each item In arrDummy1
       arrColl.Add item, item
    Next item
    Err.Clear
    ReDim arrDummy(LBound(MyArray) To arrColl.Count + LBound(MyArray) - 1)
    i = LBound(MyArray)
    For Each item In arrColl
       arrDummy(i) = item
       i = i + 1
    Next item
    RemoveDupesColl = arrDummy
End Function
Private Sub CommandButton1_Click()
Dim i%, j%, eValue%
Dim Wb As Workbook, NewWb As Workbook, Sh As Worksheet
Dim Arr, Path As String, eFile As String
Dim Rng As Range
Dim itemp
eValue = Val(UserForm4.TextBox1.Value)
If eValue > 3 Or eValue < 1 Then
    MsgBox "So ban nhap chua dung"
    Exit Sub
End If
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
    Path = ThisWorkbook.Path: eFile = ThisWorkbook.Name
    eFile = Left(eFile, Len(eFile) - 5)
    ActiveSheet.Copy
    j = 24 - eValue * 8
    Set Wb = ActiveWorkbook
    Set Sh = Wb.Sheets(1)
    With Sh
        If eValue <> 3 Then .Range("G:G").Offset(, eValue * 8 + 1).Resize(, j).EntireColumn.Delete
        .Range("D:D").Resize(, 4 + (eValue - 1) * 8).EntireColumn.Delete
        Set Rng = .Range("A3:K" & .[A65000].End(3).Row)
        Arr = RemoveDupesColl(Sh.Range("D4", Sh.[D65000].End(3)).Value)
        For Each itemp In Arr
            Set NewWb = Workbooks.Add
            Rng.AutoFilter 4, CStr(itemp)
            .Range("A1", Rng).SpecialCells(12).Copy
            With NewWb
                .Sheets(1).[A1].PasteSpecial xlPasteValues
                .Sheets(1).[A1].PasteSpecial xlPasteFormats
                .Sheets(1).Columns("A").Resize(, 11).AutoFit
                .SaveAs FileName:=Path & "\" & eFile & " - " & CStr(itemp) & "-" & UserForm4.TextBox1.Value & ".xlsx"
                .Close True
            End With
        Next itemp
    End With
    Wb.Close False
    Set Sh = Nothing
    Set NewWb = Nothing
    Set Wb = Nothing
Application.CutCopyMode = False
Application.DisplayAlerts = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Da thuc hien xong"
Unload Me
End Sub

Private Sub CommandButton2_Click()
    Unload Me
End Sub

Em cám ơn anh nhiều. Mừng quá em quên cả cái nóng trên xe đi đường dài về quê đám hiếu cuối tuần. Em sẽ vào máy tính ngay khi về đến nhà. Có gì em báo anh sau ạ. Cảm ơn anh nhiều lắm ạ

 

[Excel my love_1]

Em cảm ơn anh giaiphap. Code của anh ra đúng mong muốn của em rồi anh à. Cảm ơn anh rất nhiều. Chúc anh và gia đình luôn mạnh khoẻ