Save ไฟล์โดยจะแยกเป็น Folderโดยให้ชื่อFolderเป็นวันที่ปัจจุบัน

jeerawatnatmu · #1

สอบถามน่อยครับ เราสามารถเขียนให้มันสามารถ Save ไฟล์โดยจะแยกเป็น Folderโดยให้ชื่อFolderเป็นวันที่ปัจจุบัน เลยได้ไหมครับ
ตอนนี้ใช้วิธี Run เสร็จ ก็ค่อยมาเปลี่ยนชื่อ Folder ที่หลังเอา
ปล.มือใหม่อยู่ครับ

snasui · #2

สามารถทำได้ครับ กรณีใช้ VBA จำเป็นต้องเขียนมาเองก่อนตามกฎการใช้บอร์ดข้อ 5 ด้านบน

ตัวอย่างการสร้าง Folder ดูที่นี่ครับ wordpress/create-folder-with-vba/

ตัวอย่างการ Save As ดูที่นี่ครับ viewtopic.php?t=13041

jeerawatnatmu · #3

แนบแล้วมันขึ้นมาว่า
ผิดพลาด
ไฟล์มีขนาดใหญ่เกินไป
ครับ
[แก้ไข]

snasui · #4

ตัดไฟล์มาเฉพาะเท่าที่พอเป็นตัวอย่างครับ

ไฟล์ตัวอย่างไม่ควรมีขนาดใหญ่ นำเฉพาะส่วนที่ติดปัญหามาถามกัน

สำหรับคำว่า "อะครับ" ให้ใช้คำว่า "ครับ" แทน เนื่องจากมีเพื่อนชาวต่างชาติเข้ามาใช้ศึกษาจำนวนมาก หากแปลหน้าเว็บจะได้เข้าใจได้ครับ

jeerawatnatmu · #5

Code: Select all

Sheets("FULL").Select
Sheets("FULL").Copy

    On Error Resume Next
    MkDir _
        "\\192.168.56.240\Inventory\¨èÒÂ\Count ÊÔ¹¤éÒ»ÃÐ¨ÓÇÑ¹\2561\04-2018\To Day"
    ChDir _
        "\\192.168.56.240\Inventory\¨èÒÂ\Count ÊÔ¹¤éÒ»ÃÐ¨ÓÇÑ¹\2561\04-2018\To Day"
    ActiveWorkbook.SaveAs Filename:= _
        "\\192.168.56.240\Inventory\¨èÒÂ\Count ÊÔ¹¤éÒ»ÃÐ¨ÓÇÑ¹\2561\04-2018\To Day\Full Case.xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

    ActiveWindow.Close

ตัวนี้ครับ เพราะปัจจุบันใช้วิธีการให้ Save ลงไดร์กลางเสร็จก่อนละค่อยมาเป็นชื่อ Folder จาก To Day เป็น วันที่ปัจจุบันเอาเอง เป็น "30-03-2018" [\\192.168.56.240\Inventory\จ่าย\Count สินค้าประจำวัน\2561\04-2018\30-03-2018]

snasui · #6

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

MkDir "\\192.168.56.240\Inventory\¨èÒÂ\Count ÊÔ¹¤éÒ»ÃÐ¨ÓÇÑ¹\2561\04-2018\"&format(date,"yyyymmdd")

เป็นการใช้ฟังก์ชั่น Format เข้ามาช่วย โดยแปลงค่าวันที่ปัจจุบันเป็น ปีเดือนวัน เช่น 20180331 เป็นต้น สามารถแปลงเป็นแบบ dd-mm-yyyy หรือแบบอื่นได้ตามต้องการครับ

jeerawatnatmu · #7

ตรงส่วน ActiveWorkbook.SaveAs Filename:= เราจะใส่เป็นอะไร ครับ

snasui · #8

ใส่เป็น Path ที่จะวางข้อมูลเชื่อมกับชื่อไฟล์ครับ

jeerawatnatmu · #9

Code: Select all

Sub testone()

ActiveSheet.Name = Range("A1").Value
On Error Resume Next
 MkDir _
    "C:\Sptnet32\2561\04-2018\" & Format(Date, "dd-mm-yyyy")
 ChDir _
    "C:\Sptnet32\2561\04-2018\" & Format(Date, "dd-mm-yyyy")
    
    ActiveWorkbook.SaveAs Filename:="C:\Sptnet32\2561\04-2018\" & Format(Date, "dd-mm-yyyy") \ Full.xlsm
End Sub

ผมไม่เข้าใจตรง ActiveWorkbook.SaveAs Filename ครับ ตอนกดRun ไม่มีขึ้น error แต่ก็ไม่Save

snasui · #10

ตัวอย่างการปรับ Code ตามด้านล่างครับ

Code: Select all

Sub testone()
	dim myPath as string

	On Error Resume Next
	myPath = "C:\Sptnet32\2561\04-2018\" & Format(Date, "dd-mm-yyyy")
	ActiveSheet.Name = Range("A1").Value
	MkDir myPathath
	ChDir myPath   
	ActiveWorkbook.SaveAs Filename:= myPath & "\Full.xlsm"
End Sub

การจะให้แสดง Error จะต้อง Mark On Error Resume Next ให้เป็น Comment หรือลบทิ้งไปก่อน ไม่เช่นนั้นจะไม่เห็น Error ครับ

jeerawatnatmu · #11

ขอบคุณครับ ได้แล้วครับ แต่บ้างครั้งเวลา Run ตอนกำลังจะ Save บ้างครั้งจะมีหน้าต่าง File not found: 'C:\Users\???\AppData\Local\Temp\?????.tmp'" เด้งขึ้นมา

snasui · #12

ลองหาดูว่ามี Code ใดนอกจาก Code นี้อีกหรือไม่ครับ

สำหรับการ Debug เพื่อ Run ทีละ Step ให้คลิกลงไปใน Code แล้วกดแป้น F8 ซ้ำๆ หากมีปัญหาจะได้เห็นว่าติดขัดที่บรรทัดใด ช่วยแจ้งบรรทัดที่เป็นปัญหามาครับ

jeerawatnatmu · #13

Run F8 นานมากครับ แต่เท่าที่ลอง Run จะเป็นตรงที่กำลังจะ Save ไฟล์อย่างเดียวครับ
Code ทั้งหมดประมาณนี้ครับ กำลังหาวิธีทำให้มันสั้นลงอยู่

Code: Select all

Sub St()
'
' St Macro
'
' Keyboard Shortcut: Ctrl+Shift+S
'

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim ws4 As Worksheet
Dim ed1 As Worksheet
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim wb3 As Workbook
Dim wb4 As Workbook
Dim sPath As String

Set ws1 = Sheets(1)
Set ws2 = Sheets(2)
Set ws3 = Sheets(3)
Set ed1 = Sheets(4)
Set POP = Sheets(5)
Set r1 = Sheets(6)
Set r2 = Sheets(7)
Set r3 = Sheets(8)
Set r4 = Sheets(9)
Set ent = Sheets(10)
Set sec = Sheets(11)
Set ss = Sheets(12)
Set sr = Sheets(13)
Set re = Sheets(14)

ws1.Select
    ActiveSheet.Cells.Select
    Selection.Delete Shift:=xlUp
ws2.Select
    ActiveSheet.Cells.Select
    Selection.Delete Shift:=xlUp
ws3.Select
    ActiveSheet.Cells.Select
    Selection.Delete Shift:=xlUp
ed1.Select
    ActiveSheet.Range("D2:J1457").Select
    Selection.ClearContents
POP.Select
    ActiveSheet.Range("D2:J1801").Select
    Selection.ClearContents
r1.Select
    ActiveSheet.Range("D2:J700").Select
    Selection.ClearContents
r2.Select
    ActiveSheet.Range("D2:J643").Select
    Selection.ClearContents
r3.Select
    ActiveSheet.Range("D2:J697").Select
    Selection.ClearContents
r4.Select
    ActiveSheet.Range("D2:J643").Select
    Selection.ClearContents
ent.Select
    ActiveSheet.Range("D2:J1681").Select
    Selection.ClearContents
sec.Select
    ActiveSheet.Range("D2:J391").Select
    Selection.ClearContents
ss.Select
    ActiveSheet.Range("D2:J1201").Select
    Selection.ClearContents
sr.Select
    ActiveSheet.Range("D2:J581").Select
    Selection.ClearContents
    
Set FilePath = Workbooks.Open("C:\Sptnet32\DLEXPPA1")
Set wb1 = Workbooks("DLEXPPA1")
Set FilePath = Workbooks.Open("C:\Sptnet32\DLEXPLOC")
Set wb2 = Workbooks("DLEXPLOC")
Set FilePath = Workbooks.Open("C:\Sptnet32\XPSRC00")
Set wb3 = Workbooks("XPSRC00")

wb1.Sheets(1).Range("A:A").Copy ws1.Range("A:A")
wb2.Sheets(1).Range("A:A").Copy ws2.Range("A:A")
wb3.Sheets(1).Range("A:A").Copy ws3.Range("A:A")

wb1.Close
wb2.Close
wb3.Close

ws1.Name = "XPPAA"
ws2.Name = "XPLOC"
ws3.Name = "XPSRC"

ws1.Select
    ActiveSheet.Columns("A:A").TextToColumns Destination:=Range("A:A"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
    :="|", TrailingMinusNumbers:=True
ws2.Select
    ActiveSheet.Columns("A:A").TextToColumns Destination:=Range("A:A"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
    :="|", TrailingMinusNumbers:=True
ws3.Select
    ActiveSheet.Columns("A:A").TextToColumns Destination:=Range("A:A"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
    :="|", TrailingMinusNumbers:=True
ws3.Select
    ActiveSheet.Range("D2").Select
    LastRow = ws3.Cells(ws3.Rows.Count, "A").End(xlUp).Row

For i = 2 To LastRow
    If Selection.Value = "P" Then
        Selection.EntireRow.Delete
    ElseIf Selection.Value = "H" Then
        Selection.EntireRow.Delete
    Else
    Selection.Offset(1, 0).Select
    End If
    
Next
    

ws1.Select
        ActiveSheet.Columns("E:E").TextToColumns Destination:=Range("E1"), DataType:=xlFixedWidth, _
        OtherChar:="|", FieldInfo:=Array(0, 1), TrailingMinusNumbers:=True
        
ws2.Select
        ActiveSheet.Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
        OtherChar:="|", FieldInfo:=Array(0, 1), TrailingMinusNumbers:=True

ws2.Select
        ActiveSheet.Columns("B:B").TextToColumns Destination:=Range("B1"), DataType:=xlFixedWidth, _
        OtherChar:="|", FieldInfo:=Array(0, 1), TrailingMinusNumbers:=True

ws3.Select
        ActiveSheet.Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
        OtherChar:="|", FieldInfo:=Array(0, 1), TrailingMinusNumbers:=True
        
ws2.Range("2:2").EntireRow.Delete
        
LastRow = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row

ws2.Select

For i = 2 To LastRow
        ActiveSheet.Cells(i, 20).Select
        ws2.Cells(i, 20) = "=RC[-12]/(RC[-14]/RC[-13])"

Next

ws2.Select
    ActiveSheet.Range("T:T").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
'FULL S
ed1.Select
LastRow = ed1.Cells(ed1.Rows.Count, "C").End(xlUp).Row
For i = 2 To LastRow
        ed1.Cells(i, 4) = "=VLOOKUP(RC[-1],XPLOC!C[-3]:C[-2],2,0)"
        ed1.Cells(i, 5) = "=VLOOKUP(RC[-2],XPLOC!C[-4]:C[-2],3,0)"
        ed1.Cells(i, 6) = "=VLOOKUP(RC[-3],XPLOC!C[-5]:C[14],20,0)"
        ed1.Cells(i, 7) = "=VLOOKUP(RC[-3],XPPAA!C[-6]:C[6],13,0)"
        ed1.Cells(i, 8) = "=VLOOKUP(RC[-4],XPPAA!C[-7]:C[6],14,0)"
        ed1.Cells(i, 9) = "=VLOOKUP(RC[-5],XPPAA!C[-8]:C[11],20,0)"
        ed1.Cells(i, 10) = "=VLOOKUP(RC[-7],XPSRC!C[-9]:C[4],14,0)"
Next
'FULL N
'POP S
POP.Select
LastRow = POP.Cells(POP.Rows.Count, "C").End(xlUp).Row
For i = 2 To LastRow
        POP.Cells(i, 4) = "=VLOOKUP(RC[-1],XPLOC!C[-3]:C[-2],2,0)"
        POP.Cells(i, 5) = "=VLOOKUP(RC[-2],XPLOC!C[-4]:C[-2],3,0)"
        POP.Cells(i, 6) = "=VLOOKUP(RC[-3],XPLOC!C[-5]:C[14],20,0)"
        POP.Cells(i, 7) = "=VLOOKUP(RC[-3],XPPAA!C[-6]:C[6],13,0)"
        POP.Cells(i, 8) = "=VLOOKUP(RC[-4],XPPAA!C[-7]:C[6],14,0)"
        POP.Cells(i, 9) = "=VLOOKUP(RC[-5],XPPAA!C[-8]:C[11],20,0)"
        POP.Cells(i, 10) = "=VLOOKUP(RC[-7],XPSRC!C[-9]:C[4],14,0)"
Next
'POP N
'R1 s
r1.Select
LastRow = r1.Cells(r1.Rows.Count, "C").End(xlUp).Row
For i = 2 To LastRow
        r1.Cells(i, 4) = "=VLOOKUP(RC[-1],XPLOC!C[-3]:C[-2],2,0)"
        r1.Cells(i, 5) = "=VLOOKUP(RC[-2],XPLOC!C[-4]:C[-2],3,0)"
        r1.Cells(i, 6) = "=VLOOKUP(RC[-3],XPLOC!C[-5]:C[14],20,0)"
        r1.Cells(i, 7) = "=VLOOKUP(RC[-3],XPPAA!C[-6]:C[6],13,0)"
        r1.Cells(i, 8) = "=VLOOKUP(RC[-4],XPPAA!C[-7]:C[6],14,0)"
        r1.Cells(i, 9) = "=VLOOKUP(RC[-5],XPPAA!C[-8]:C[11],20,0)"
        r1.Cells(i, 10) = "=VLOOKUP(RC[-7],XPSRC!C[-9]:C[4],14,0)"
Next
'R1 n
'R2 s
r2.Select
LastRow = r2.Cells(r2.Rows.Count, "C").End(xlUp).Row
For i = 2 To LastRow
        r2.Cells(i, 4) = "=VLOOKUP(RC[-1],XPLOC!C[-3]:C[-2],2,0)"
        r2.Cells(i, 5) = "=VLOOKUP(RC[-2],XPLOC!C[-4]:C[-2],3,0)"
        r2.Cells(i, 6) = "=VLOOKUP(RC[-3],XPLOC!C[-5]:C[14],20,0)"
        r2.Cells(i, 7) = "=VLOOKUP(RC[-3],XPPAA!C[-6]:C[6],13,0)"
        r2.Cells(i, 8) = "=VLOOKUP(RC[-4],XPPAA!C[-7]:C[6],14,0)"
        r2.Cells(i, 9) = "=VLOOKUP(RC[-5],XPPAA!C[-8]:C[11],20,0)"
        r2.Cells(i, 10) = "=VLOOKUP(RC[-7],XPSRC!C[-9]:C[4],14,0)"
Next
'R2 n
'R3 s
r3.Select
LastRow = r3.Cells(r3.Rows.Count, "C").End(xlUp).Row
For i = 2 To LastRow
        r3.Cells(i, 4) = "=VLOOKUP(RC[-1],XPLOC!C[-3]:C[-2],2,0)"
        r3.Cells(i, 5) = "=VLOOKUP(RC[-2],XPLOC!C[-4]:C[-2],3,0)"
        r3.Cells(i, 6) = "=VLOOKUP(RC[-3],XPLOC!C[-5]:C[14],20,0)"
        r3.Cells(i, 7) = "=VLOOKUP(RC[-3],XPPAA!C[-6]:C[6],13,0)"
        r3.Cells(i, 8) = "=VLOOKUP(RC[-4],XPPAA!C[-7]:C[6],14,0)"
        r3.Cells(i, 9) = "=VLOOKUP(RC[-5],XPPAA!C[-8]:C[11],20,0)"
        r3.Cells(i, 10) = "=VLOOKUP(RC[-7],XPSRC!C[-9]:C[4],14,0)"
Next
'R3 n
'R4 s
r4.Select
LastRow = r4.Cells(r4.Rows.Count, "C").End(xlUp).Row
For i = 2 To LastRow
        r4.Cells(i, 4) = "=VLOOKUP(RC[-1],XPLOC!C[-3]:C[-2],2,0)"
        r4.Cells(i, 5) = "=VLOOKUP(RC[-2],XPLOC!C[-4]:C[-2],3,0)"
        r4.Cells(i, 6) = "=VLOOKUP(RC[-3],XPLOC!C[-5]:C[14],20,0)"
        r4.Cells(i, 7) = "=VLOOKUP(RC[-3],XPPAA!C[-6]:C[6],13,0)"
        r4.Cells(i, 8) = "=VLOOKUP(RC[-4],XPPAA!C[-7]:C[6],14,0)"
        r4.Cells(i, 9) = "=VLOOKUP(RC[-5],XPPAA!C[-8]:C[11],20,0)"
        r4.Cells(i, 10) = "=VLOOKUP(RC[-7],XPSRC!C[-9]:C[4],14,0)"
Next
'R4 n
'ent s
ent.Select
LastRow = ent.Cells(ent.Rows.Count, "C").End(xlUp).Row
For i = 2 To LastRow
        ent.Cells(i, 4) = "=VLOOKUP(RC[-1],XPLOC!C[-3]:C[-2],2,0)"
        ent.Cells(i, 5) = "=VLOOKUP(RC[-2],XPLOC!C[-4]:C[-2],3,0)"
        ent.Cells(i, 6) = "=VLOOKUP(RC[-3],XPLOC!C[-5]:C[14],20,0)"
        ent.Cells(i, 7) = "=VLOOKUP(RC[-3],XPPAA!C[-6]:C[6],13,0)"
        ent.Cells(i, 8) = "=VLOOKUP(RC[-4],XPPAA!C[-7]:C[6],14,0)"
        ent.Cells(i, 9) = "=VLOOKUP(RC[-5],XPPAA!C[-8]:C[11],20,0)"
        ent.Cells(i, 10) = "=VLOOKUP(RC[-7],XPSRC!C[-9]:C[4],14,0)"
Next
'ent n
'sec s
sec.Select
LastRow = sec.Cells(sec.Rows.Count, "C").End(xlUp).Row
For i = 2 To LastRow
        sec.Cells(i, 4) = "=VLOOKUP(RC[-1],XPLOC!C[-3]:C[-2],2,0)"
        sec.Cells(i, 5) = "=VLOOKUP(RC[-2],XPLOC!C[-4]:C[-2],3,0)"
        sec.Cells(i, 6) = "=VLOOKUP(RC[-3],XPLOC!C[-5]:C[14],20,0)"
        sec.Cells(i, 7) = "=VLOOKUP(RC[-3],XPPAA!C[-6]:C[6],13,0)"
        sec.Cells(i, 8) = "=VLOOKUP(RC[-4],XPPAA!C[-7]:C[6],14,0)"
        sec.Cells(i, 9) = "=VLOOKUP(RC[-5],XPPAA!C[-8]:C[11],20,0)"
        sec.Cells(i, 10) = "=VLOOKUP(RC[-7],XPSRC!C[-9]:C[4],14,0)"
Next
'sec n
'ss s
ss.Select
LastRow = ss.Cells(ss.Rows.Count, "C").End(xlUp).Row
For i = 2 To LastRow
        ss.Cells(i, 4) = "=VLOOKUP(RC[-1],XPLOC!C[-3]:C[-2],2,0)"
        ss.Cells(i, 5) = "=VLOOKUP(RC[-2],XPLOC!C[-4]:C[-2],3,0)"
        ss.Cells(i, 6) = "=VLOOKUP(RC[-3],XPLOC!C[-5]:C[14],20,0)"
        ss.Cells(i, 7) = "=VLOOKUP(RC[-3],XPPAA!C[-6]:C[6],13,0)"
        ss.Cells(i, 8) = "=VLOOKUP(RC[-4],XPPAA!C[-7]:C[6],14,0)"
        ss.Cells(i, 9) = "=VLOOKUP(RC[-5],XPPAA!C[-8]:C[11],20,0)"
        ss.Cells(i, 10) = "=VLOOKUP(RC[-7],XPSRC!C[-9]:C[4],14,0)"
Next
'ss n
'sr s
sr.Select
LastRow = sr.Cells(sr.Rows.Count, "C").End(xlUp).Row
For i = 2 To LastRow
        sr.Cells(i, 4) = "=VLOOKUP(RC[-1],XPLOC!C[-3]:C[-2],2,0)"
        sr.Cells(i, 5) = "=VLOOKUP(RC[-2],XPLOC!C[-4]:C[-2],3,0)"
        sr.Cells(i, 6) = "=VLOOKUP(RC[-3],XPLOC!C[-5]:C[14],20,0)"
        sr.Cells(i, 7) = "=VLOOKUP(RC[-3],XPPAA!C[-6]:C[6],13,0)"
        sr.Cells(i, 8) = "=VLOOKUP(RC[-4],XPPAA!C[-7]:C[6],14,0)"
        sr.Cells(i, 9) = "=VLOOKUP(RC[-5],XPPAA!C[-8]:C[11],20,0)"
        sr.Cells(i, 10) = "=VLOOKUP(RC[-7],XPSRC!C[-9]:C[4],14,0)"
Next
'sr n
ed1.Select
    ActiveSheet.Range("D2:J1457").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
POP.Select
    ActiveSheet.Range("D2:J1801").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
r1.Select
    ActiveSheet.Range("D2:J700").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
r2.Select
    ActiveSheet.Range("D2:J643").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
r3.Select
    ActiveSheet.Range("D2:J697").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
r4.Select
    ActiveSheet.Range("D2:J643").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
ent.Select
    ActiveSheet.Range("D2:J1681").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
sec.Select
    ActiveSheet.Range("D2:J391").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
ss.Select
    ActiveSheet.Range("D2:J1201").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
sr.Select
    ActiveSheet.Range("D2:J581").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    

ed1.Select
    ActiveSheet.Columns("J:J").Replace What:="#N/A", Replacement:="0", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    ActiveSheet.Columns("G:I").Replace What:="#N/A", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    ActiveSheet.Columns("F:F").Replace What:="#VALUE!", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

POP.Select
    ActiveSheet.Columns("J:J").Replace What:="#N/A", Replacement:="0", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    ActiveSheet.Columns("G:I").Replace What:="#N/A", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    ActiveSheet.Columns("F:F").Replace What:="#VALUE!", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

r1.Select
    ActiveSheet.Columns("J:J").Replace What:="#N/A", Replacement:="0", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    ActiveSheet.Columns("G:I").Replace What:="#N/A", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    ActiveSheet.Columns("F:F").Replace What:="#VALUE!", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

r2.Select
    ActiveSheet.Columns("J:J").Replace What:="#N/A", Replacement:="0", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    ActiveSheet.Columns("G:I").Replace What:="#N/A", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    ActiveSheet.Columns("F:F").Replace What:="#VALUE!", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
     
r3.Select
    ActiveSheet.Columns("J:J").Replace What:="#N/A", Replacement:="0", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    ActiveSheet.Columns("G:I").Replace What:="#N/A", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    ActiveSheet.Columns("F:F").Replace What:="#VALUE!", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
     
r4.Select
    ActiveSheet.Columns("J:J").Replace What:="#N/A", Replacement:="0", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    ActiveSheet.Columns("G:I").Replace What:="#N/A", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    ActiveSheet.Columns("F:F").Replace What:="#VALUE!", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    
ent.Select
    ActiveSheet.Columns("J:J").Replace What:="#N/A", Replacement:="0", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    ActiveSheet.Columns("G:I").Replace What:="#N/A", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    ActiveSheet.Columns("F:F").Replace What:="#VALUE!", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

sec.Select
    ActiveSheet.Columns("J:J").Replace What:="#N/A", Replacement:="0", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    ActiveSheet.Columns("G:I").Replace What:="#N/A", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    ActiveSheet.Columns("F:F").Replace What:="#VALUE!", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    
ss.Select
    ActiveSheet.Columns("J:J").Replace What:="#N/A", Replacement:="0", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    ActiveSheet.Columns("G:I").Replace What:="#N/A", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    ActiveSheet.Columns("F:F").Replace What:="#VALUE!", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    
sr.Select
    ActiveSheet.Columns("J:J").Replace What:="#N/A", Replacement:="0", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    ActiveSheet.Columns("G:I").Replace What:="#N/A", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    ActiveSheet.Columns("F:F").Replace What:="#VALUE!", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    
Sheets("FULL").Select
Sheets("FULL").Copy
        On Error Resume Next
    MkDir _
        "\\192.168.56.240\Inventory\¨èÒÂ\Count ÊÔ¹¤éÒ»ÃÐ¨ÓÇÑ¹\2561\04-2018\" & Format(Date, "dd-mm-yyyy")
    ChDir _
        "\\192.168.56.240\Inventory\¨èÒÂ\Count ÊÔ¹¤éÒ»ÃÐ¨ÓÇÑ¹\2561\04-2018\" & Format(Date, "dd-mm-yyyy")
        
        sPath = "\\192.168.56.240\Inventory\¨èÒÂ\Count ÊÔ¹¤éÒ»ÃÐ¨ÓÇÑ¹\2561\04-2018\" & Format(Date, "dd-mm-yyyy")
        
        ActiveWorkbook.SaveAs Filename:=sPath & "\Full Case.xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

    ActiveWindow.Close
    

Sheets("POP").Select
Sheets("POP").Copy
        On Error Resume Next
    MkDir _
        "\\192.168.56.240\Inventory\¨èÒÂ\Count ÊÔ¹¤éÒ»ÃÐ¨ÓÇÑ¹\2561\04-2018\" & Format(Date, "dd-mm-yyyy")
    ChDir _
        "\\192.168.56.240\Inventory\¨èÒÂ\Count ÊÔ¹¤éÒ»ÃÐ¨ÓÇÑ¹\2561\04-2018\" & Format(Date, "dd-mm-yyyy")
        
        sPath = "\\192.168.56.240\Inventory\¨èÒÂ\Count ÊÔ¹¤éÒ»ÃÐ¨ÓÇÑ¹\2561\04-2018\" & Format(Date, "dd-mm-yyyy")
        
        ActiveWorkbook.SaveAs Filename:=sPath & "\Pop.xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

    ActiveWindow.Close
    
Sheets("R1").Select
Sheets("R1").Copy
        On Error Resume Next
    MkDir _
        "\\192.168.56.240\Inventory\¨èÒÂ\Count ÊÔ¹¤éÒ»ÃÐ¨ÓÇÑ¹\2561\04-2018\" & Format(Date, "dd-mm-yyyy")
    ChDir _
        "\\192.168.56.240\Inventory\¨èÒÂ\Count ÊÔ¹¤éÒ»ÃÐ¨ÓÇÑ¹\2561\04-2018\" & Format(Date, "dd-mm-yyyy")
        
        sPath = "\\192.168.56.240\Inventory\¨èÒÂ\Count ÊÔ¹¤éÒ»ÃÐ¨ÓÇÑ¹\2561\04-2018\" & Format(Date, "dd-mm-yyyy")
        
        ActiveWorkbook.SaveAs Filename:=sPath & "\R1.xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

    ActiveWindow.Close
    
Sheets("R2").Select
Sheets("R2").Copy
    On Error Resume Next
    MkDir _
        "\\192.168.56.240\Inventory\¨èÒÂ\Count ÊÔ¹¤éÒ»ÃÐ¨ÓÇÑ¹\2561\04-2018\" & Format(Date, "dd-mm-yyyy")
    ChDir _
        "\\192.168.56.240\Inventory\¨èÒÂ\Count ÊÔ¹¤éÒ»ÃÐ¨ÓÇÑ¹\2561\04-2018\" & Format(Date, "dd-mm-yyyy")
        
        sPath = "\\192.168.56.240\Inventory\¨èÒÂ\Count ÊÔ¹¤éÒ»ÃÐ¨ÓÇÑ¹\2561\04-2018\" & Format(Date, "dd-mm-yyyy")
        
        ActiveWorkbook.SaveAs Filename:=sPath & "\R2.xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

    ActiveWindow.Close
    
Sheets("R3").Select
Sheets("R3").Copy
    On Error Resume Next
    MkDir _
        "\\192.168.56.240\Inventory\¨èÒÂ\Count ÊÔ¹¤éÒ»ÃÐ¨ÓÇÑ¹\2561\04-2018\" & Format(Date, "dd-mm-yyyy")
    ChDir _
        "\\192.168.56.240\Inventory\¨èÒÂ\Count ÊÔ¹¤éÒ»ÃÐ¨ÓÇÑ¹\2561\04-2018\" & Format(Date, "dd-mm-yyyy")
        
        sPath = "\\192.168.56.240\Inventory\¨èÒÂ\Count ÊÔ¹¤éÒ»ÃÐ¨ÓÇÑ¹\2561\04-2018\" & Format(Date, "dd-mm-yyyy")
        
        ActiveWorkbook.SaveAs Filename:=sPath & "\R3.xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

    ActiveWindow.Close
    
Sheets("R4").Select
Sheets("R4").Copy
    On Error Resume Next
    MkDir _
        "\\192.168.56.240\Inventory\¨èÒÂ\Count ÊÔ¹¤éÒ»ÃÐ¨ÓÇÑ¹\2561\04-2018\" & Format(Date, "dd-mm-yyyy")
    ChDir _
        "\\192.168.56.240\Inventory\¨èÒÂ\Count ÊÔ¹¤éÒ»ÃÐ¨ÓÇÑ¹\2561\04-2018\" & Format(Date, "dd-mm-yyyy")
        
        sPath = "\\192.168.56.240\Inventory\¨èÒÂ\Count ÊÔ¹¤éÒ»ÃÐ¨ÓÇÑ¹\2561\04-2018\" & Format(Date, "dd-mm-yyyy")
        
        ActiveWorkbook.SaveAs Filename:=sPath & "\R4.xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

    ActiveWindow.Close
    
Sheets("ENT").Select
Sheets("ENT").Copy
    On Error Resume Next
    MkDir _
        "\\192.168.56.240\Inventory\¨èÒÂ\Count ÊÔ¹¤éÒ»ÃÐ¨ÓÇÑ¹\2561\04-2018\" & Format(Date, "dd-mm-yyyy")
    ChDir _
        "\\192.168.56.240\Inventory\¨èÒÂ\Count ÊÔ¹¤éÒ»ÃÐ¨ÓÇÑ¹\2561\04-2018\" & Format(Date, "dd-mm-yyyy")
        
        sPath = "\\192.168.56.240\Inventory\¨èÒÂ\Count ÊÔ¹¤éÒ»ÃÐ¨ÓÇÑ¹\2561\04-2018\" & Format(Date, "dd-mm-yyyy")
        
        ActiveWorkbook.SaveAs Filename:=sPath & "\Entertain.xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

    ActiveWindow.Close
    
Sheets("SEC").Select
Sheets("SEC").Copy
    On Error Resume Next
    MkDir _
        "\\192.168.56.240\Inventory\¨èÒÂ\Count ÊÔ¹¤éÒ»ÃÐ¨ÓÇÑ¹\2561\04-2018\" & Format(Date, "dd-mm-yyyy")
    ChDir _
        "\\192.168.56.240\Inventory\¨èÒÂ\Count ÊÔ¹¤éÒ»ÃÐ¨ÓÇÑ¹\2561\04-2018\" & Format(Date, "dd-mm-yyyy")
        
        sPath = "\\192.168.56.240\Inventory\¨èÒÂ\Count ÊÔ¹¤éÒ»ÃÐ¨ÓÇÑ¹\2561\04-2018\" & Format(Date, "dd-mm-yyyy")
        
        ActiveWorkbook.SaveAs Filename:=sPath & "\Security.xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

    ActiveWindow.Close
    
Sheets("SS").Select
Sheets("SS").Copy
    On Error Resume Next
    MkDir _
        "\\192.168.56.240\Inventory\¨èÒÂ\Count ÊÔ¹¤éÒ»ÃÐ¨ÓÇÑ¹\2561\04-2018\" & Format(Date, "dd-mm-yyyy")
    ChDir _
        "\\192.168.56.240\Inventory\¨èÒÂ\Count ÊÔ¹¤éÒ»ÃÐ¨ÓÇÑ¹\2561\04-2018\" & Format(Date, "dd-mm-yyyy")
        
        sPath = "\\192.168.56.240\Inventory\¨èÒÂ\Count ÊÔ¹¤éÒ»ÃÐ¨ÓÇÑ¹\2561\04-2018\" & Format(Date, "dd-mm-yyyy")
        
        ActiveWorkbook.SaveAs Filename:=sPath & "\Store Supply.xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

    ActiveWindow.Close
    
Sheets("SR").Select
Sheets("SR").Copy
    On Error Resume Next
    MkDir _
        "\\192.168.56.240\Inventory\¨èÒÂ\Count ÊÔ¹¤éÒ»ÃÐ¨ÓÇÑ¹\2561\04-2018\" & Format(Date, "dd-mm-yyyy")
    ChDir _
        "\\192.168.56.240\Inventory\¨èÒÂ\Count ÊÔ¹¤éÒ»ÃÐ¨ÓÇÑ¹\2561\04-2018\" & Format(Date, "dd-mm-yyyy")
        
        sPath = "\\192.168.56.240\Inventory\¨èÒÂ\Count ÊÔ¹¤éÒ»ÃÐ¨ÓÇÑ¹\2561\04-2018\" & Format(Date, "dd-mm-yyyy")
        
        ActiveWorkbook.SaveAs Filename:=sPath & "\Strong Room.xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

    ActiveWindow.Close
    
Sheets("RUN").Select
ActiveWorkbook.Save

MsgBox "Program Complete"
End Sub

snasui · #14

ถ้า Code ตัวอย่างทำงานได้เมื่อนำไปใช้จริงก็ต้องทำงานได้ครับ

กรณีต้องการจะดูว่าเป็นปัญหาที่การ Save จริงให้ Run บรรทัดอื่นทั้งหมดก่อนบรรทัด Save แล้วค่อยมา Run บรรทัด Save ทีละ Step

วิธีการ Run บรรทัดอื่นทั้งหมด เลือก Code นั้นแล้วกดปุ่ม F8 จากนั้นไปยังบรรทัดก่อนหน้าบรรทัดที่จะ Save คลิกขวาแล้วเลือก Run to Cursor โปรแกรมจะ Run มารวดเดียวจนหยุด ณ บรรทัดนั้น จากนั้นค่อยกดปุ่ม F8 เพื่อ Run ทีละ Step หากผิดพลาดที่บรรทัด Save จริงโปรแกรมจะฟ้องหลังจาก Run บรรทัด Save ครับ

Excel Forum

EXCEL TOOLS

Save ไฟล์โดยจะแยกเป็น Folderโดยให้ชื่อFolderเป็นวันที่ปัจจุบัน

Save ไฟล์โดยจะแยกเป็น Folderโดยให้ชื่อFolderเป็นวันที่ปัจจุบัน

Re: Save ไฟล์โดยจะแยกเป็น Folderโดยให้ชื่อFolderเป็นวันที่ปัจจุบัน

Re: Save ไฟล์โดยจะแยกเป็น Folderโดยให้ชื่อFolderเป็นวันที่ปัจจุบัน

Re: Save ไฟล์โดยจะแยกเป็น Folderโดยให้ชื่อFolderเป็นวันที่ปัจจุบัน

Re: Save ไฟล์โดยจะแยกเป็น Folderโดยให้ชื่อFolderเป็นวันที่ปัจจุบัน

Re: Save ไฟล์โดยจะแยกเป็น Folderโดยให้ชื่อFolderเป็นวันที่ปัจจุบัน

Re: Save ไฟล์โดยจะแยกเป็น Folderโดยให้ชื่อFolderเป็นวันที่ปัจจุบัน

Re: Save ไฟล์โดยจะแยกเป็น Folderโดยให้ชื่อFolderเป็นวันที่ปัจจุบัน

Re: Save ไฟล์โดยจะแยกเป็น Folderโดยให้ชื่อFolderเป็นวันที่ปัจจุบัน

Re: Save ไฟล์โดยจะแยกเป็น Folderโดยให้ชื่อFolderเป็นวันที่ปัจจุบัน

Re: Save ไฟล์โดยจะแยกเป็น Folderโดยให้ชื่อFolderเป็นวันที่ปัจจุบัน

Re: Save ไฟล์โดยจะแยกเป็น Folderโดยให้ชื่อFolderเป็นวันที่ปัจจุบัน

Re: Save ไฟล์โดยจะแยกเป็น Folderโดยให้ชื่อFolderเป็นวันที่ปัจจุบัน

Re: Save ไฟล์โดยจะแยกเป็น Folderโดยให้ชื่อFolderเป็นวันที่ปัจจุบัน