Tách 1 file ra thành nhiều file theo điều kiện

[saobekhonglac]

Chào anh/chị..

Nhờ anh/chị tạo giúp em code để xuất dữ liệu từ file “Sum” ra thành nhiều file với tên theo điều kiện tại cột K (mỗi DH xuất thành 1 file,em làm tay thử 3 đơn hàng đầu). Trong file có sử dụng công thức, khi xuất ra có thể dán giá trị hoặc công thức nhưng đảm bảo các chỉ tiêu phải đúng.
B6 = A14, các dòng còn lại từ A1à H12 được vlookup dựa vào B6.
A14 à H113 cũng được link từ sheet khác.
Từ E114, G114 là công thức Sum (nếu đơn hàng 1 có 2 dòng thì công thức chỉ sum 2 dòng)
G115,G116, tính từ G114.

Cám ơn anh/chị nhiều.

 

[haonlh]

Bạn tách để in (dùng cho riêng mình) hay để gửi cho khách (người này không biết nội dung của người kia)???

 

[saobekhonglac]

Mình tách để gửi cho người khác, người này không được xem file của người khác.

Bạn tách để in (dùng cho riêng mình) hay để gửi cho khách (người này không biết nội dung của người kia)???

 

[saobekhonglac]

Chắc yêu cầu khó làm hay sau mà không ai giúp vậy ta.

 

[hamhocexcel92]

Mong ngóng giải pháp từ các cao thủ VBA, yêu cầu của bạn này khá hay.

 

[quanluu]

Chào anh/chị..

Nhờ anh/chị tạo giúp em code để xuất dữ liệu từ file “Sum” ra thành nhiều file với tên theo điều kiện tại cột K (mỗi DH xuất thành 1 file,em làm tay thử 3 đơn hàng đầu). Trong file có sử dụng công thức, khi xuất ra có thể dán giá trị hoặc công thức nhưng đảm bảo các chỉ tiêu phải đúng.
B6 = A14, các dòng còn lại từ A1à H12 được vlookup dựa vào B6.
A14 à H113 cũng được link từ sheet khác.
Từ E114, G114 là công thức Sum (nếu đơn hàng 1 có 2 dòng thì công thức chỉ sum 2 dòng)
G115,G116, tính từ G114.

Cám ơn anh/chị nhiều.

Không muốn thay đổi định dạng hay công thức của bạn. bạn thử dùng code dài dài này coi

Sub tach()
    Dim sh As Worksheet, wb As Workbook, arr, darr()
    Dim i, k, Tmp As String, cuoi, dau As Integer, sh1 As Worksheet
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    arr = Range("A14:A113").Value
    ReDim darr(1 To UBound(arr), 1)
    Set Dic = CreateObject("Scripting.Dictionary")
    With Dic
        For i = 1 To UBound(arr)
            Tmp = arr(i, 1)
            If Tmp <> "" And Not .Exists(Tmp) Then
                k = k + 1
                .Add Tmp, k
                darr(k, 1) = arr(i, 1)
            End If
        Next
    End With
    Set sh = ThisWorkbook.Sheets("Sum")
    For i = 1 To UBound(darr)
        If darr(i, 1) <> "" Then
            Set wb = Workbooks.Add
            sh.Copy before:=wb.ActiveSheet
            Set sh1 = wb.ActiveSheet
            sh1.Range("B6") = darr(i, 1)
            sh1.Name = darr(i, 1)
            For k = 113 To 14 Step -1
                If arr(k - 13, 1) = darr(i, 1) Then
                    If k < 113 Then sh1.Rows(k + 1 & ":113").Delete
                    GoTo 1
                End If
            Next
1:
            For k = 14 To 113
                If arr(k - 13, 1) = darr(i, 1) Then
                    If k > 14 Then sh1.Rows("14:" & k - 1).Delete
                    GoTo 2
                End If
            Next
2:
            wb.SaveAs ThisWorkbook.Path & "\" & darr(i, 1), 51
            wb.Close
        End If
    Next
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub