ขอคำแนะนำ CodeVB สร้าง Folder พร้อม Save ไฟล์ลง Folder

[tigerwit]

จากไฟล์ที่แนบมา
ต้องการ
1. สร้าง Folder โดยตั้งชื่อ Folder ตามเซลล์ O2
2. ต้องการ save ไฟล์ โดนตั้งชื่อ ตามเซลล์ M2
ต้องปรับ Code อย่างไรครับ

Code: Select all

Sub EeportData()
        On Error Resume Next
        Dim sFolderPath As String
        Dim oFSO As Object
        Dim wb1 As Workbook
        Dim ws1 As Worksheet
        Dim wb2 As Workbook
        Dim Path As String
        Dim FName As String
        sFolderPath = "C:\" & Range("O2")
        'sFolderPath = "C:\PD\"
        MkDir sFolderPath
        Set wb1 = ThisWorkbook
        Set ws1 = wb1.Sheets("Exp")
        Path = sFolderPath
        'Path = "C:\PD\"
        FName = ws1.Range("M2") & ".xlsx"
        ws1.Range("A:G").Copy
        Set wb2 = Workbooks.Add
        With wb2.ActiveSheet.Range("A:G")
        .PasteSpecial (xlValues)
        .PasteSpecial (xlFormats)
        End With
        Application.DisplayAlerts = False
        wb2.SaveAs filename:=Path & FName
        Application.DisplayAlerts = True
        wb2.Close
End Sub

[snasui]

ตัวอย่างการปรับ Code ครับ

Code: Select all

Sub Daily_Report()
    Dim sFolderPath As String
'    Dim oFSO As Object
    Dim wb1 As Workbook
    Dim ws1 As Worksheet
    Dim wb2 As Workbook
    Dim Path As String
    Dim FName As String
    
    On Error Resume Next
    sFolderPath = "C:\" & Range("O2").Value

    'sFolderPath = "C:\PD\"
    If Dir(sFolderPath, vbDirectory) = "" Then
        MkDir sFolderPath
    End If
    Set wb1 = ThisWorkbook
    Set ws1 = wb1.Sheets("Exp")
'    Path = sFolderPath
    'Path = "C:\PD\"
    FName = ws1.Range("M2") & ".xlsx"
    ws1.Range("A:G").Copy
    Set wb2 = Workbooks.Add
    With wb2.ActiveSheet.Range("A:G")
        .PasteSpecial (xlValues)
        .PasteSpecial (xlFormats)
    End With
    Application.DisplayAlerts = False
    wb2.SaveAs Filename:=sFolderPath & "\" & FName
    Application.DisplayAlerts = True
    wb2.Close
End Sub

เซลล์ M2 ต้องมีค่าด้วย Code ถึงจะทำงานได้ กรณีเป็น M2 จากชีตอื่นที่ไม่ใช่ชีต Main จะต้องเขียนระบุชื่อชีตประกอบเข้าไปด้วย Code ด้านบนนี้ค่าใน O2 และ M2 จะนำมาจากชีต Main ครับ

[tigerwit]

ขอบคุณครับผม
สอบถามต่อครับ

Code: Select all

    Set ws1 = wb1.Sheets("Exp")

ถ้าเราไม่อ้างถึงชื่อชีท exp แต่จะอ้างถึง sheet ตรงๆเลย (sheet23)
ทำได้ไหมครับ ต้องเขียนอย่างไร

[snasui]

ทำได้และเขียนตรง ๆ ได้เลยเป็นเช่น Set ws1 = Sheet23 ครับ

[tigerwit]

ขอบคุณครับ