Excel 用于在“另存为”对话框中将工作表另存为预设文件的VBA代码

我一直在尝试一些代码，但似乎都不起作用。下面的代码是我发现的最接近我想要实现的代码，但是仍然有一些地方不对劲

我想将工作表“合并”移动到新工作簿，并将工作簿保存为预填充的文件名consolidated.xlsx。我希望弹出对话框，以便用户只选择他们想要的文件夹。代码似乎按预期工作，但是当您单击“保存”时，它实际上不会生成已保存的文件

非常感谢您的帮助

多谢各位

Sub Export()
Dim pathh As Variant

    ActiveWorkbook.Sheets("consolidated").Copy
    pathh = Application.GetSaveAsFilename( _
            FileFilter:="xlWorkbookDefault Files (*.xlsx), *.xlsx", _
            Title:="Consolidated", _
            InitialFileName:=filenamestring)
Application.DisplayAlerts = True
End Sub

另一次尝试保存文件，但未显示保存位置对话框：

Application.Goto ActiveWorkbook.Sheets("consolidated").Cells(1, 1)
ActiveSheet.Copy
ActiveWorkbook.SaveAs filename:=("Consolidated"), FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close savechanges:=False

您可以尝试：

Sub Export()
    Dim pathh As Variant

    pathh = Application.GetSaveAsFilename( _
        FileFilter:="xlWorkbookDefault Files (*.xlsx), *.xlsx", _
        Title:="Consolidated", _
        InitialFileName:="Consolidated.xlsx")
    If pathh <> False then
        ActiveWorkbook.Sheets("consolidated").Copy
        ActiveWorkbook.Close Filename:=pathh
    End If
End Sub

子导出（）
Dim pathh作为变体
pathh=Application.GetSaveAsFilename（_
FileFilter:=“xlWorkbookDefault文件（*.xlsx），*.xlsx”_
标题：=“合并”_
InitialFileName:=“Consolidated.xlsx”）
如果pathh为False，则
ActiveWorkbook.Sheets（“合并”）。副本
ActiveWorkbook.Close文件名：=路径
如果结束
端接头

由于

.SaveAs

会弄乱当前文件，我尝试不使用它

这或多或少是我用来创建模板文件的，但经过修改后可以创建常规文件

Public Sub CreateTemplate(Sheet As Excel.Worksheet, TemplateFile As String)
Dim SaveFormat As Long, SheetsInNewWorkbook As Long
Dim oBook As Excel.Workbook
Dim FileFormat As Integer

    ' Delete the old file, if it exists (to avoid the possible overwrite prompt later)
    On Error Resume Next
    Kill (TemplateFile)
    On Error GoTo 0

    'Remember the user's setting
    SaveFormat = Application.DefaultSaveFormat
    SheetsInNewWorkbook = Application.SheetsInNewWorkbook

    ' Change the DefaultSaveFormat, which controls the format when creating a new workbook.
    'Set the file format to the new 2007+ (.xlsx) format (with 1048576 rows), with 1 sheet
    Application.DefaultSaveFormat = xlOpenXMLWorkbook   '51
    Application.SheetsInNewWorkbook = 1
    'If you want the old 97-2003 (.xls) format (65536 rows), use
    'Application.DefaultSaveFormat = xlWorkbookNormal    '-4143

    ' Create a new Workbook
    Set oBook = Application.Workbooks.Add

    'Set DefaultSaveFormat & SheetsInNewWorkbook back to the user's settings
    Application.DefaultSaveFormat = SaveFormat
    Application.SheetsInNewWorkbook = SheetsInNewWorkbook

    ' Copy the sheet to the new Workbook
    Sheet.Copy After:=oBook.Sheets(1)
    ' Make sure the sheet is Visible (since my templates are hidden sheets)
    oBook.Sheets(2).Visible = True
    ' Supress the prompt to delete the blank Sheet(1)
    Application.DisplayAlerts = False
    oBook.Sheets(1).Delete

    ' Set the save format...
    FileFormat = xlOpenXMLWorkbook   '51
    ' For templates, use
    'FileFormat = xlTemplate    '17

    ' Save the file
    oBook.SaveAs Filename:=TemplateFile, FileFormat:=FileFormat, ReadOnlyRecommended:=False, CreateBackup:=False

    ' Return the prompts to normal
    Application.DisplayAlerts = True
    ' Close the Workbook, and clear the memory
    oBook.Close
    Set oBook = Nothing
End Sub

你可以说这很简单，就像这样：

CreateTemplate ActiveSheet, pathh

---

GetSaveAsFilename不保存文件，它只是让用户选择一个文件名。你必须有代码来保存文件。看看@VincentG I更新了另一个版本的代码，它完成了所有工作，但允许用户选择保存文件的对话框。您能在第二行代码上提供帮助吗？不要使用“复制”，而是使用工作表中的“另存为”，而不是工作簿中的“另存为”。如果不适用于我@VincentGOpen的对话框，请单击“保存”。然后，它会打开另一个对话框，询问是否要使用文件名book13保存。没有按预期工作。您可以复制它的方式是，将工作表命名为合并在新工作簿中，您将在运行代码时看到我的意思。