VBA以特定名称保存工作表

Question

嗨，可能是一个简单的答案，但我是 VBA 新手。

我在工作簿中有一个工作表。此工作表在单元格 A1 中有一个特定的引用，每次使用时都会更改。它基本上是一个订单号，格式为 03 01 15。接下来是 03 02 15，然后是 03 03 15，依此类推。

我想要做的是使用 VBA 将工作表保存在我的订单文件夹中的新工作簿中，并将新工作簿称为订单号。

我可以使用记录宏功能来获取基本的 VBA 来复制工作表、打开一个新工作簿、粘贴值并关闭工作簿，但我很难获得正确的名称。每个新工作簿将根据订单号具有不同的名称。

如有任何帮助，将不胜感激。

Answer 1

Option Explicit
Sub FileNameToFolder()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Title: FileNameToFolder
'Description: Uses 'filename-valid' contents of a cell in a worksheet of a
'    'source' workbook as the filename for a 'destination' workbook containing
'    only a copy of the worksheet itself to be created in an existing folder in
'    the 'source' worksbook's folder.
'Remarks: The program will fail if you use characters like <, >, :, ", /, \, |,
'    ? or * in the cell and if the existing folder does not exist. If the
'    'destination' workbook exists, excel will display an alert to overwrite it;
'    if you don't click yes, the program will fail.
'Idea Source Title: VBA to save worksheet with a specific name
'Idea Source Link Address: https://*.com/questions/32097449/vba-to-save-worksheet-with-a-specific-name
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Variables
  'Const
    Const cStrFolder As String = "Orders"
    Const cStrSep As String = "\"
    Const cStrRef As String = "A1"
    Const cStrExt As String = ".xls"
  'Dim
    Dim wbActive As Workbook 'DefaultFilePath Issue
    Dim wsActive As Worksheet
    Dim strFile As String
    Dim strPath As String
    Dim strFullPath As String
    Dim wbDest As Workbook
'Program
    Set wbActive = ActiveWorkbook
    Set wsActive = wbActive.ActiveSheet
    strPath = wbActive.Path
    strFile = wsActive.Range(cStrRef).Value
    strFullPath = strPath & cStrSep & cStrFolder & cStrSep & strFile & cStrExt
  'Creates a copy of the worksheet in a new workbook (no need for workbooks.Add)
    wsActive.Copy
    On Error GoTo ProgErr
        ActiveWorkbook.SaveAs Filename:=strFullPath
        Set wbDest = ActiveWorkbook
        wbDest.Close
    Exit Sub
ProgErr:
    MsgBox "Read the remarks section of the code."
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''