ต้องการความช่วยเหลือครับ ณ ปัจจุบัน สามารถแตก File ออกมาเป็น 1 ต่อ 1 ได้แล้วครับ ทีนี้คืออยากจะสร้าง Folder ตามชื่อ File

[Dtoms]

ต้องการความช่วยเหลือครับ ณ ปัจจุบัน สามารถแตก File ออกมาเป็น 1 ต่อ 1 ได้แล้วครับ ทีนี้คืออยากจะสร้าง Folder ตามชื่อ File ที่เราจะ Save แล้วเข้าไป save File ใน Folder นั้นๆ ผมต้องดำเนินการอย่างไรครับ

Code: Select all

Sub Macro1()
'
' Macro1 Macro

ThisWorkbook.ActiveSheet.Columns("ac:ay").EntireColumn.Delete

For r = 2 To Range("F65536").End(xlUp).Row

Range("G2").Value = Range("F" & r).Value

xdata = Range("G2").Value
 
    Workbooks.Add
    ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & xdata & ".xlsx"
        

      Windows(xdata & ".xlsx").Activate
 
      Application.CutCopyMode = False
      ActiveWorkbook.Close True
      
        
         
         Next r

End Sub

[puriwutpokin]

ปรับตามนี้ครับ ครั้งหน้าฝากแนบไฟล์ตัวอย่างมาด้วยครับจะได้สะดวกต่อการตอบของเพื่อนๆสมาชิกครับ

Code: Select all

Sub Macro1()
'
' Macro1 Macro
ThisWorkbook.ActiveSheet.Columns("ac:ay").EntireColumn.Delete
For r = 2 To Range("F65536").End(xlUp).Row
Range("G2").Value = Range("F" & r).Value
xdata = Range("G2").Value
MkDir (ThisWorkbook.Path & "\" & xdata)
    Workbooks.Add
    ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & xdata & "\" & xdata & ".xlsx"
      Windows(xdata & ".xlsx").Activate
      Application.CutCopyMode = False
      ActiveWorkbook.Close True
      Next r
End Sub

[Dtoms]

ขอบคุณมากๆเลยครับผม