VBA以使用特定名称保存工作表

时间:2015-08-19 13:49:55

标签: excel vba excel-vba

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

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

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

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

任何帮助都会得到满足。

1 个答案:

答案 0 :(得分: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://stackoverflow.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
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''