code

Sub CreateMonthlySheets()
    Dim monthNames As Variant
    Dim i As Integer
    
    ' ชื่อเดือน
    monthNames = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
    
    ' ลูปเพื่อสร้างชีท
    For i = LBound(monthNames) To UBound(monthNames)
        ' ตรวจสอบว่าชีทมีอยู่แล้วหรือไม่
        On Error Resume Next
        Worksheets(monthNames(i)).Name = monthNames(i)
        If Err.Number <> 0 Then
            Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = monthNames(i)
            Err.Clear
        End If
        On Error GoTo 0
    Next i
End Sub

วน loop

Sub FillNumbersInRange()
    Dim i As Integer
    
    ' Loop from 1 to 5
    For i = 1 To 5
        ' Place the number in cells B5 to B9
        Cells(5 + i - 1, 2).Value = i
    Next i
End Sub

วน loop ดึงจากชีท

Sub ConsolidateData()
    Dim wsSummary As Worksheet
    Dim wsTeam As Worksheet
    Dim teamNames As Variant
    Dim i As Integer
    Dim j As Integer

    ' ชื่อชีททีม
    teamNames = Array("TeamA", "TeamB", "TeamC")
    
    ' กำหนดชีท Summary
    Set wsSummary = ThisWorkbook.Sheets("Summary Sheet")
    
    ' วนลูปเพื่อรวบรวมข้อมูล
    For i = LBound(teamNames) To UBound(teamNames)
        ' กำหนดชีทแต่ละทีม
        Set wsTeam = ThisWorkbook.Sheets(teamNames(i))
        
        ' วางข้อมูลจาก B3:B5 ในชีท Summary
        For j = 0 To 2 ' ตั้งแต่ 0 ถึง 2 สำหรับ 3 แถว
            wsSummary.Cells(4 + j, 2 + i).Value = wsTeam.Cells(3 + j, 2).Value
        Next j
    Next i
End Sub

วน loop แยกไฟล์

Sub SplitDataBySeller()
    Dim ws As Worksheet
    Dim table As ListObject
    Dim sellerColumn As Range
    Dim seller As Range
    Dim uniqueSellers As Collection
    Dim sellerName As Variant
    Dim newWorkbook As Workbook
    Dim dataSheet As Worksheet
    Dim outputFolder As String
    Dim outputFilePath As String
    Dim headerRange As Range
    Dim copyRange As Range
    
    ' กำหนดชีทและตาราง
    Set ws = ActiveSheet
    Set table = ws.ListObjects("fulldata")
    
    ' กำหนดคอลัมน์ผู้ขาย
    Set sellerColumn = table.ListColumns("ผู้ขาย").DataBodyRange
    outputFolder = "C:\test\"
    
    ' สร้างคอลเลกชันสำหรับเก็บชื่อผู้ขายที่ไม่ซ้ำ
    Set uniqueSellers = New Collection
    On Error Resume Next
    For Each seller In sellerColumn
        uniqueSellers.Add seller.Value, CStr(seller.Value)
    Next seller
    On Error GoTo 0

    ' ปิดการอัปเดตหน้าจอ
    Application.ScreenUpdating = False
    
    ' วนลูปสร้างไฟล์สำหรับแต่ละผู้ขาย
    For Each sellerName In uniqueSellers
        ' สร้างไฟล์ใหม่
        Set newWorkbook = Workbooks.Add
        Set dataSheet = newWorkbook.Sheets(1)
        dataSheet.Name = "data"
        
        ' คัดลอกหัวตาราง
        table.HeaderRowRange.Copy Destination:=dataSheet.Range("A1")
        
        ' คัดลอกข้อมูลของผู้ขายไปยังชีทใหม่
        table.Range.AutoFilter Field:=table.ListColumns("ผู้ขาย").Index, Criteria1:=sellerName
        
        ' กำหนดช่วงที่ต้องการคัดลอก (รวมทั้งหัวตาราง)
        Set copyRange = Union(table.HeaderRowRange, table.DataBodyRange.SpecialCells(xlCellTypeVisible))
        copyRange.Copy Destination:=dataSheet.Range("A1")
        
        ' ปิดการกรอง
        table.AutoFilter.ShowAllData
        
        ' บันทึกไฟล์
        outputFilePath = outputFolder & sellerName & ".xlsx"
        newWorkbook.SaveAs Filename:=outputFilePath, FileFormat:=xlOpenXMLWorkbook
        newWorkbook.Close False
    Next sellerName
    
    ' เปิดการอัปเดตหน้าจออีกครั้ง
    Application.ScreenUpdating = True
End Sub