VBA การใช้ Filter เพื่อ Save Unique Item

[champize]

เรียน ท่านผู้รู้

ผมต้องการใช้ VBA เพื่อ Filter ค่า Unique ของแต่ละ Office แล้ว Save as report เก็บไว้
โดยได้ลองผิดลองถูกใช้สูตรจาก Google มาดัดแปลง
ตอนนี้ติดปัญหาที่ Code VBA ที่เขียน เริ่ม Filter ที่ Row 1
1. ผมต้องการให้เริ่ม Filter ที่ Row 2 เพื่อเก็บหัว Column row 1 ไว้
2. ต้องการให้แต่ละไฟล์ที่ Save as ติดช่อง Sum Total ด้านล่างไปด้วย
ต้องปรับ Code อย่างไรบ้างครับ
โดยได้ code เบื้องต้นตามไฟล์แนบ

Code: Select all

Option Explicit

Const Target_Folder As String = "C:\Users\win10\Desktop\Macro"
Dim wsSource As Worksheet, wsHelper As Worksheet
Dim LastRow As Long, LastColumn As Long

Sub SplitDataset()
    
    Dim collectionUniqueList As Collection
    Dim i As Long
    
    Set collectionUniqueList = New Collection
    
    Set wsSource = ThisWorkbook.Worksheets("OT_Report")
    Set wsHelper = ThisWorkbook.Worksheets("Helper")
    
    ' Clear Helper Worksheet
    wsHelper.Cells.ClearContents
    
    With wsSource
        .AutoFilterMode = False
        
        LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        LastColumn = .Cells(1, Columns.Count).End(xlToLeft).Column
        
        If .Range("A2").Value = "" Then
            GoTo Cleanup
        End If
        
        Call Init_Unique_List_Collection(collectionUniqueList, LastRow)
        
        Application.DisplayAlerts = False
        
        For i = 1 To collectionUniqueList.Count
                SplitWorksheet (collectionUniqueList.Item(i))
        Next i
        
        ActiveSheet.AutoFilterMode = False
        
    End With

Cleanup:

    Application.DisplayAlerts = True
    Set collectionUniqueList = Nothing
    Set wsSource = Nothing
    Set wsHelper = Nothing

End Sub

Private Sub Init_Unique_List_Collection(ByRef col As Collection, ByVal SourceWS_LastRow As Long)
    
    Dim LastRow As Long, RowNumber As Long
    
    ' Unique List Column
    wsSource.Range("E2:E" & SourceWS_LastRow).Copy wsHelper.Range("A1")
    
    With wsHelper
        
        If Len(Trim(.Range("A1").Value)) > 0 Then
            
            LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
            
            .Range("A1:A" & LastRow).RemoveDuplicates 1, xlNo
            
            LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
            
            .Range("A1:A" & LastRow).Sort .Range("A1"), Header:=xlNo
            
            LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
            
            On Error Resume Next
            For RowNumber = 1 To LastRow
                col.Add .Cells(RowNumber, "A").Value, CStr(.Cells(RowNumber, "A").Value)
            Next RowNumber
           
        End If
    
    End With
    
End Sub

Private Sub SplitWorksheet(ByVal Category_Name As Variant)
    
    Dim wbTarget As Workbook
    
    Set wbTarget = Workbooks.Add
    
    With wsSource
        
        With .Range(.Cells(1, 1), .Cells(LastRow, LastColumn))
            .AutoFilter .Range("E2").Column, Category_Name
            
            .Copy
            
            'wbTarget.Worksheets(1).PasteSpecial xlValues
            wbTarget.Worksheets(1).Paste
            wbTarget.Worksheets(1).Name = "OT Report"
            
            wbTarget.SaveAs Target_Folder & Category_Name & ".xlsx", 51
            wbTarget.Close False
            
        End With
        
    End With
    
    Set wbTarget = Nothing
    
End Sub

[snasui]

กรุณาแจ้งรายละเอียดเพิ่มเติมติมตามกฎการใช้บอร์ดข้อ 5 ด้านบน นอกจากนี้ช่วยแจ้งลำดับการทดสอบมาว่า คลิกปุ่มไหน คีย์เซลล์ไหน หรือต้องทำอย่างไรในการทดสอบ จะได้เข้าถึงปัญหาได้โดยไวครับ

[champize]

กรุณาแจ้งรายละเอียดเพิ่มเติมติมตามกฎการใช้บอร์ดข้อ 5 ด้านบน นอกจากนี้ช่วยแจ้งลำดับการทดสอบมาว่า คลิกปุ่มไหน คีย์เซลล์ไหน หรือต้องทำอย่างไรในการทดสอบ จะได้เข้าถึงปัญหาได้โดยไวครับ

เรียน อาจารย์
ผมเพิ่งหัดใช้ VBA เป็นครั้งแรกหากอธิบายไม่เข้าใจก็ขอโทษด้วยนะครับ
1. หลังจากกด Run Marco จะได้ไฟล์ตามภาพ "ผลจาก Code ปัจจุบัน" (ปัญหาคือ Column Row ที่ 2 หายไป และไม่มียอด Total ที่บรรทัดสุดท้าย)
2. ซึ่งจริงๆแล้วผมต้องการให้ไฟล์ออกมาแบบภาพ "ที่ต้องการให้เป็น" (มีหัว Column Row ที่ 2 และมียอด Total ที่บรรทัดสุดท้าย)

[snasui]

ตัวอย่างการอธิบายวิธีการทำงานประกอบภาพที่แนบมาเพื่อให้ผู้ตอบสามารถเข้าถึงปัญหาได้โดยเร็ว สามารถอธิบายเช่นด้านล่างนี้ครับ

Code ที่แนบมาเริ่มทำงานที่ Sub SplitDataset() จะมีการเรียก Sub Init_Unique_List_Collection เพื่อสร้างรายการเก็บไว้ใน Collection ที่ชีต Helper และจะใช้รายการเหล่านี้ไป Filter ข้อมูลในชีต OT_Report และคัดลอกข้อมูลไปสร้างเป็นไฟล์ใหม่ใน Path ที่กำหนดไว้ด้วย Sub SplitWorksheet

ปัญหาคือ Sub SplitWorksheet ไม่ได้เริ่ม Filter ที่บรรทัดที่ 2 นอกจากนี้ยังไม่ได้คัดลอกบรรทัดที่เป็นยอดรวมไปด้วย

ตัวอย่างการปรับ Code ที่ Sub SplitWorksheet ครับ

Code: Select all

'Other code
With wsSource
    .Range("e" & LastRow + 1).Value = Category_Name
    With .Range(.Cells(2, 1), .Cells(LastRow, LastColumn))
        .AutoFilter .Range("E2").Column, Category_Name
        .Parent.Range("e" & LastRow + 1).ClearContents
        .Parent.UsedRange.Copy
'Other code

[champize]

เรียน อาจารย์
ผมได้ลองทดสอบแล้ว Code ของอาจารย์สามารถใช้ได้ครับ ขอบคุณมากครับ