กดปุ่มแล้วให้สร้างไฟล์ใหม่จากชื่ออ้างเซลล์

[godman]

ถ้าผมได้โค้ดแบบนี้ แต่ปรากฏว่ามัน error เมื่อนำไปใช้งาน
ที่มาที่ไป คือ ผมอยากจะสร้างไฟล์ใหม่ โดยใช้ชื่อไฟล์โดยอ้างอิงชื่อไฟล์ใหม่จากเซลใดก็ได้ ในที่นี่ผมให้เป็นเซล A1 ของชี้ตที่มี macro นี้อยู่ครับ โดยอยากให้มันยกทั้งชี้ตนี้ ชี้ตเดียวแล้วไปสร้างไฟล์ใหม่ ครับ ไม่ทราบต้องปรับแต่งโค้ดตรงใหนให้ทำงานได้ครับ
ลักษณะ error จะออกมาประมาณนี้ครับ
Commpli error
Expect fuction or variable

Code: Select all

Sub AddNew()
     
    Dim wbName As String
     
    wbName = [A1].Value
     
    Set NewBook = Workbooks.Add
    With NewBook
        .Title = wbName
         ' add your additional code here
        .SaveAs Filename:=wbName
    End With
End Sub

[snasui]

กรณีไม่ต้องการให้เกิด Error ให้ลบ Code ใน Module1 ทิ้งไปครับ

ที่ Error เพราะว่าไปกำหนดให้ตัวแปรเป็นชื่อเดียวกับชื่อ Procedure ใน Module1 ครับ

[godman]

ขอบคุณครับ สำหรับคำแนะนำ ผมได้ไปลบออกและสามารถใช้การได้ดี แต่ ยังไม่สามารถ copy ข้อมูลไปไว้ใน file ใหม่ได้ครับ คือ ความต้องการของผมคือ ให้ยกไปตั้งชื่อไฟล์ใหม่และนำข้อมูลใน sheet นั้นไปทั้งหมดครับ ผมลองเขียน code ให้มัน Copy Paste แต่ยังไม่สามารถรันได้ ครับ
ช่วยแนะนำด้วยครับว่าต้องเขียนโค้ดอย่างไรให้ทำงานได้ อาจจะไม่เอา object ก็ได้ครับ

Code: Select all

Sub AddNew()
     
    Dim wbName As String
     
    wbName = [A1].Value
     
    Set NewBook = Workbooks.Add
    With NewBook
        .Title = wbName
         ' add your additional code here
        .SaveAs Filename:=wbName
    End With
    Call CopyPaste
    
End Sub

Sub CopyPaste()
'
' Macro3 Macro
'

'
    Range("A2:G6").Select
    Selection.Copy
    Windows("UserID.xlsx").Activate
    Range("A2").Select
    ActiveSheet.Paste
End Sub

[snasui]

ลองปรับ Code เป็นตามด้านล่างครับ

Code: Select all

Sub AddNew()
     
    Dim wbName As String
    Dim rAll As Range
    Dim rTarget As Range
    
    Set rAll = Sheets("tblUsers").Range("A2:G6")
    wbName = [A1].Value
     
    Set NewBook = Workbooks.Add
    With NewBook
        Set rTarget = Sheets("Sheet1").Range("A1")
        .Title = wbName
         ' add your additional code here
         rAll.Copy rTarget
        .SaveAs Filename:=wbName
    End With
'    Call CopyPaste
    
End Sub

[godman]

ขอบคุณผู้รู้ทุกท่านครับ ตอนนี้ใช้งานได้ระดับดีทีเดียว เชื่อว่าจะนำไป apply ใช้ได้มากมายในงาน

[godman]

พอดีว่าผมได้ไปดัดแปลงโค้ดไปใส่ใน workbook ที่ต้องการใช้จริงๆ ปรากฏว่าขึ้น errror ว่า Compile error Expect fuction or variable สาเหตุและแนวทางแก้ไขทำได้อย่างไรครับ

Code: Select all

Sub AddNewbomxxTEST()
     
    Dim wbName As String
    Dim rAll As Range
    Dim rTarget As Range
    
    Set rAll = Sheets("Report0").Range("A2:k43")
    wbName = [I1].Value
     
    Set NewBook = Workbooks.Add
    With NewBook
        Set rTarget = Sheets("Sheet1").Range("A1")
        .Title = wbName
         ' add your additional code here
         rAll.Copy rTarget
        .SaveAs Filename:=wbName
    End With
'    Call CopyPaste
    
End Sub

    
Sub CopyPaste()
'
' Macro3 Macro
'

'
    Range("A2:k43").Select
    Selection.Copy
    Windows("UserID.xlsx").Activate
    Range("A2").Select
    ActiveSheet.Paste
End Sub

[snasui]

Code ในไฟล์แนบกับที่เขียนมาไม่เหมือนกันครับ ถ้ายังไม่ได้เขียนไว้ในไฟล์แนบ ช่วยเขียนแล้วแนบมาใหม่ครับ

[godman]

หลังจากที่ผมไปปรับโน่นปรับนี่ ก็ใช้ได้ครับ แต่ว่าผมได้ใส่โค้ดเพื่อต้องการให้มัน สามารถ copy paste special ครั้งแรกให้วางเป็น value แล้วก็อีกครั้งเป็น format อีกครั้งเป็น colump width จุดประสงค์เพื่อให้เหมือนกับต้นทาง สำหรับไฟล์ที่ถูกสร้างใหม่นี้ ผมใช้โค้ดข้างล่างนี้ แต่ว่า ไม่สามารถทำให้เป็นเหมือนกับต้นทางได้่ครับ รู้สึกว่ามันมาแบบไม่กำหนดรูปแบบให้ อยากให้มันรักษารูปแบบตามต้นทาง และไม่อยากให้แสดง grid line ไม่ทราบต้องปรับโค้ดส่วนใหนครับ ขอบคุณครับ ผมแนบไฟล์มาด้วย

Code: Select all

Sub AddNew()
     
  Dim wbName As String
    Dim rAll As Range
    Dim rTarget As Range
    
    Set rAll = Sheets("Report0").Range("A1:k43")
    wbName = [I1].Value
     
    Set NewBook = Workbooks.Add
    With NewBook
        Set rTarget = Sheets("Sheet1").Range("A1")
        .Title = wbName
         ' add your additional code here
         rAll.Copy rTarget
        .SaveAs Filename:=wbName
    End With
'    Call CopyPasteokmai
    
End Sub

Sub CopyPasteokmai()
 Range("A1:k43").Select
    Selection.Copy
    Windows("UserID.xlsx").Activate
    Range("A2").Select
    ActiveSheet.Paste
 Windows("UserID.xlsx").Activate
Range("A1:J42").Select
    Selection.Copy
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("L25").Select
End Sub

[niwat2811]

ลองแบบนี้ไม่ทราบว่าตรงกับความต้องการไหมครับ

Code: Select all

Sub CreateNew()
    Sheets("Report0").Select
    Sheets("Report0").Copy
Application.DisplayAlerts = False
With ActiveWorkbook
wbName = [I1].Value
    .Title = wbName
    .SaveAs Filename:=wbName
End With
Application.DisplayAlerts = True
End Sub

[godman]

สุดยอดเลยครับ ตรงความต้องการเป้ะ ผมอยากได้แบบนี้แหละ ขอบพระคุณเป็นอย่างสูง

[godman]

จากโค้ดนี้ เป็นการ copy sheet ไปไว้อีกชี้ตโดยไม่เอาสูตรไปด้วย ผมมีความต้องการเพิ่มครับ ถ้าผมต้องการให้ระบุ folder ที่จะนำไฟล์ใหม่นี้ไปเก็บไว้ในที่เดียวกัน
ผมใช้ชื่อโฟล์เดอร์ว่า L:\Quality System\YEAR 2013
ผมจะต้องนำที่อยู่ folder ไปไว้ที่ส่วนใหนของโค้ดนี้ครับ

Code: Select all

Sub CreateNew()
 Sheets("Report0").Select
    Sheets("Report0").Copy
Application.DisplayAlerts = False
With ActiveWorkbook
wbName = [I1].Value
    .Title = wbName
    .SaveAs Filename:=wbName
End With
Application.DisplayAlerts = True
End Sub

[tupthai]

Code: Select all

.SaveAs Filename:"L:\Quality System\YEAR 2013\"&wbName

[godman]

ขอบพระคุณเป็นอย่างสูงครับ คุณ tubthai

[godman]

สวัสดีครับ
เนื่องจากผมเคยตั้งกระทู้เกี่ยวกับการ สร้างไฟล์ใหม่จากชี้ตและตั้งชื่อไฟล์ใหม่แบบไดนามิค ตามเซลล์
ผมได้นำไปใช้ หลายงาน แต่มีปัญหางานหนึ่งที่ต้องสร้างโค้ดไว้ให้กด submit แล้วส่งไฟล์ที่แยกออกไปไปให้ผู้ใช้งานกรอกข้อมูลในช่องสีแดง ให้ครบ ปรากฏว่าพอนำไปใช้ macro มันยังอ้างอิงจาก master file อยู่ครับ ทำให้ไฟล์ที่แยกออกไป แม้ว่าจะใส่ข้อมูลแล้ว แต่ว่ามันก็ยังจดจำไฟล์ master อยู่ ผมสังเกตุดูการลิ้งมายังไฟล์ต้นฉบับ
ผมอยากทราบว่า ทำอย่างไรจะให้มันทำงานกับไฟล์ที่แยกออกไปได้ครับ
ผมใช้โค้ด if else แบบนี้ แล้วให้มัน call โค้ดสร้างไฟล์ครับ

Code: Select all

Sub checkred_blank()
If Worksheets("report0").Range("H10") = "" Then
 MsgBox "You have to enter data"
 Else
  Call Sheet1.CreateNew
 End If
 End Sub

[snasui]

การสร้างไฟล์ใหม่โดยการ Copy Sheet ไปจะไม่มี Code VBA ติดไปด้วย ยกเว้นจะใช้การ Save As ไป ดังนั้นการเรียกใช้ Macro จึงจะเรียกใช้จากไฟล์หลักครับ

[godman]

ขอบคุณอาจารย์มากครับ ผมทำได้แล้วครับ ผมไปเก็บมาโครไว้ใน personal.xlsb ครับ เรียกใช้จากที่นี่ปรากฏว่าทำงานได้เฉยเลย

[yodpao.b]

ไม่มีอะไรครับ อยากเก็บหน้านี้ไว้

[godman]

สวัสดีครับ
ผมได้นำโค้ดข้างล่างไปใช้ เพื่อ copy ไปสร้างไฟล์ห่ม่ โดยอ้างอิงชื่อจาก เซลล์ I1 แต่มีความต้องการเพิ่มเติมคือ มัน copy ไปแต่ข้อความ ทำอย่างไรให้มัน copy โค้ด VBA ทั้งหมดไปด้วยกับไฟล์ใหม่ครับ ต้องเปลี่ยนส่วนใหนของโค้ดนี้ครับ ขอบคุณครับ สำหรับเวลาที่มาช่วยครับ

Code: Select all

Sub AddNew()
     
  Dim wbName As String
    Dim rAll As Range
    Dim rTarget As Range
    
    Set rAll = Sheets("Report0").Range("A1:k43")
    wbName = [I1].Value
     
    Set NewBook = Workbooks.Add
    With NewBook
        Set rTarget = Sheets("Sheet1").Range("A1")
        .Title = wbName
         ' add your additional code here
         rAll.Copy rTarget
        .SaveAs Filename:="D:\KEEPER_BOM\" & wbName
       
    End With
'    Call CopyPasteokmai
    
End Sub

[snasui]

ไฟล์ที่จะมี Macro ได้จะต้องมีนามสกุลเป็นอย่างอื่นที่ไม่ใช่ .xlsx ครับ