Xin code VBA export file

[thang.phduy2]

Chào các anh chị.

Em xin anh chị giúp đỡ.

Em cần code VBA có thể lọc cột D - Qty >0, và lưu thành các file riêng biệt với tên file theo ghi chú cột E.

Cảm ơn anh chị GPE.

 

[Nhattanktnn]

Chào các anh chị.

Em xin anh chị giúp đỡ.

Em cần code VBA có thể lọc cột D - Qty >0, và lưu thành các file riêng biệt với tên file theo ghi chú cột D.

Cảm ơn anh chị GPE.

Chưa hiểu ý bạn lắm,theo như nội dung bạn mô tả thì dữ liệu từ cột A->E bạn muốn tách thành từng file riêng biệt? Vậy căn cứ vào đâu để biết một file lấy mấy dòng? Và "Ghi chú cột D" là cái gì? tôi chỉ thấy số 1. Mà 2 file trùng số 1 thì không thể lưu

 

[thang.phduy2]

Chưa hiểu ý bạn lắm,theo như nội dung bạn mô tả thì dữ liệu từ cột A->E bạn muốn tách thành từng file riêng biệt? Vậy căn cứ vào đâu để biết một file lấy mấy dòng? Và "Ghi chú cột D" là cái gì? tôi chỉ thấy số 1. Mà 2 file trùng số 1 thì không thể lưu

Cảm ơn anh đã reply ạ.

1. Đính chính lại là tên file theo cột E.

2. 1 file có số dòng dựa vào Cột E. FIle "A" sẽ có tất cả các dòng có ghi chú là A và Cột D có Qty >0. Tương tự cho file "B".

Cảm ơn anh.

 

[Nhattanktnn]

Cảm ơn anh đã reply ạ.

1. Đính chính lại là tên file theo cột E.

2. 1 file có số dòng dựa vào Cột E. FIle "A" sẽ có tất cả các dòng có ghi chú là A và Cột D có Qty >0. Tương tự cho file "B".

Cảm ơn anh.

Có tình trạng lộn xộn kiểu A|A|B|B|A|B|C|C không? hay liền mạch hết A tới B tới C

 

[thang.phduy2]

Có tình trạng lộn xộn kiểu A|A|B|B|A|B|C|C không? hay liền mạch hết A tới B tới C

Có lộn xộn như anh đề cập. Cảm ơn anh.

 

[Nhattanktnn]

Có lộn xộn như anh đề cập. Cảm ơn anh.

Bạn thử code này, có vấn đề gì bàn tiếp

Option Explicit
Sub SplitFile()
    Dim Sh As Worksheet, oWb As Workbook, nWb As Workbook
    Dim Dic As Object, sPath As String, Rng As Range, I As Long, Arr()
    Dim iKey As Variant
    Set oWb = ThisWorkbook: sPath = oWb.Path
    Set Sh = oWb.Sheets("Export")
    Set Dic = CreateObject("Scripting.Dictionary")
    With Sh
        Set Rng = .Range("A1:E" & .Range("E65536").End(xlUp).Row)
        Arr = Rng.Offset(, 3).Resize(, 2).Value
        .Cells(1, "F") = "Qty": .Cells(2, "F") = ">0": .Cells(1, "G") = "Carton"
        For I = 2 To UBound(Arr)
            If Arr(I, 1) > 0 And Arr(I, 2) <> Empty Then
                Dic.Item(Arr(I, 2)) = ""
            End If
        Next
        For Each iKey In Dic.Keys
            .Cells(2, "G") = iKey
            Set nWb = Workbooks.Add
            Rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sh.Range("F1:G2"), CopyToRange:=Range("A1"), Unique:=False
            nWb.Close True, Filename:=sPath & "\" & iKey
        Next
    End With
End Sub

 

[thang.phduy2]

Option Explicit Sub SplitFile() Dim Sh As Worksheet, oWb As Workbook, nWb As Workbook Dim Dic As Object, sPath As String, Rng As Range, I As Long, Arr() Dim iKey As Variant Set oWb = ThisWorkbook: sPath = oWb.Path Set Sh = oWb.Sheets("Export") Set Dic = CreateObject("Scripting.Dictionary") With Sh Set Rng = .Range("A1:E" & .Range("E65536").End(xlUp).Row) Arr = Rng.Offset(, 3).Resize(, 2).Value .Cells(1, "F") = "Qty": .Cells(2, "F") = ">0": .Cells(1, "G") = "Carton" For I = 2 To UBound(Arr) If Arr(I, 1) > 0 And Arr(I, 2) <> Empty Then Dic.Item(Arr(I, 2)) = "" End If Next For Each iKey In Dic.Keys .Cells(2, "G") = iKey Set nWb = Workbooks.Add Rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sh.Range("F1:G2"), CopyToRange:=Range("A1"), Unique:=False nWb.Close True, Filename:=sPath & "\" & iKey Next End With End Sub

Cảm ơn anh.

Code chạy trơn tru.