Excel Forum

Code: Select all

Option Explicit

Sub SaveFileOnCellVal()
    Dim FileSaveName As String
    FileSaveName = Worksheets("หน้าหลัก").Range("D5") 'กำหนดชื่อไฟลไว้ที่เซลล์ D5 ของหน้าหลัก
    Worksheets("คำสั่ง").Cells.Copy 'ตัวอย่างนี้เป็นการ Copy ชีท คำสั่ง
    Workbooks.Add 'เปิด Workbook ขึ้นมาใหม่
    Range("A1").Select
    Selection.PasteSpecial xlPasteValues
    Application.CutCopyMode = False
            ChDir "D:\การจัดซื้อจัดจ้างปีงบประมาณ2554" 'เปลี่ยน Folder ให้ชี้ไปที่ D:\การจัดซื้อจัดจ้างปีงบประมาณ2554
             If FileSaveName <> "" Then
                ActiveWorkbook.SaveAs Filename:=FileSaveName, FileFormat:=xlNormal ' Save File ตามชื่อที่ให้ไว้ลงใน Folder ด้านบน
                MsgBox "Already save file " & FileSaveName
            End If
    Application.DisplayAlerts = False
    ActiveWindow.Close
    Application.DisplayAlerts = True
End Sub

Code: Select all

Sub CopyNewSheet()
Dim strNameSheet As String
Dim i As Integer
'strNameSheet = InputBox("Please enter sheet name.", "Name Sheet For Save") 'กำหนดชื่อซีทเองตามต้องการ
   'If strNameSheet = "" Then
       'Exit Sub
    'End If
strNameSheet = Worksheets("หน้าหลัก").Range("D5")
   If strNameSheet = "" Then
       Exit Sub
    End If
    For i = 1 To Worksheets.Count
        If UCase(Worksheets(i).Name) = UCase(strNameSheet) Then
           MsgBox "มีรายชื่อซ้ำ.....กรุณาตรวจสอบใหม่"
           Exit Sub
        End If
Next
   strNameSheet = Worksheets("หน้าหลัก").Range("D5") 'กำหนดชื่อซีทไว้ที่เซลล์ D5 ของหน้าหลัก
    Worksheets("รายงาน").Copy After:=Worksheets(Worksheets.Count) 'กำหนดซีทที่ต้องการ COPY
    ActiveSheet.Name = strNameSheet
     ActiveSheet.Cells.Copy
    ActiveSheet.Cells.PasteSpecial xlPasteValues
     Application.CutCopyMode = False
    
End Sub