VBA保存带有特定名称的工作表

Hi probably a simple answer but im new to VBA.

嗨，也许是一个简单的回答，但我对VBA还不熟悉。

I have a worksheet in a workbook. This worksheet has a specific reference in cell A1 which changes each time its used. It is basically an order number and formatted 03 01 15. The next will be 03 02 15, then 03 03 15 and so on.

我在工作簿里有一份工作表。这个工作表在单元格A1中有一个特定的引用，每次使用它时都会发生变化。它基本上是一个订单号和格式化的03 01 15。下一个是03 02 15，然后是03 03 15，等等。

What I want to do is to use VBA to save the sheet in a new workbook in my orders folder, and for the new workbook to be called the order number.

我要做的是使用VBA将工作表保存在orders文件夹中的新工作簿中，并将新工作簿命名为order number。

I can use the record macro function to get the basic VBA to copy the sheet, open a new workbook, paste the values and close the workbook, but im struggling with getting the name right. Each new workbook will have a different name based on the order number.

我可以使用录制宏函数来获得基本的VBA来复制工作表、打开新的工作簿、粘贴值并关闭工作簿，但是我很难把名字写对。每个新的工作簿将根据订单号有不同的名称。

Any help would be appriciated.

任何帮助都将收取费用。

1 个解决方案

#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 = Application.ActiveWorkbook
    Set wsActive = Application.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
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''