首页 > 解决方案 > 使用另存为对话框将工作表保存到新工作簿

问题描述

从代码 Excel 首先使用当前工作簿名称和今天日期创建一本新书,并将其保存在同一路径中。

我面临的问题是我想使用“另存为对话框”来保存文件。

当我使用另存为对话框时。我需要先选择路径并创建一个新工作簿,然后将数据粘贴到新工作簿中。

但我不知道如何先创建一个新工作簿并返回当前路径来复制数据。

请帮助我。

Sub MakeReport()
    Dim thisBookName As String
    Dim newBookName As String
    Dim newBookPath As String
    Dim todayDate As String
    Dim newBook As Workbook
    Dim numTests As Integer
    Dim shtCount As Integer
    Dim ws as worksheets

    shtCount = Sheets.Count

    ' Set input arrays
    For Each ws In ThisWorkbook.worksheets
        Select Case ws.Name
            Case "A", "D", "E" 'Skip these sheets       
            Case Else   
                ' Procced?

                answer = MsgBox("Are you sure you wish to Make Report?", vbYesNo + vbQuestion, "Make Report")
                If answer = vbNo Then
                    Exit Sub
                Else
                    ' proceed
                End If

                ' Check if there are data sheet tabs
                If shtCount < numTests + 2 Then
                    MsgBox ("Data not tally")
                    Exit Sub
                End If

                ' Set new Spreadsheet's name
                todayDate = Format(CStr(Now), "yy_mm_dd")
                thisBookName = ThisWorkbook.Name
                newBookName = Replace(thisBookName, ".xlsm", "") & "_" & todayDate & ".xlsx"
                newBookPath = ThisWorkbook.Path & "\" & newBookName

                ' Copy and paste data tabs into new WorkBook
                For i = 1 To numTests + 3
                    Workbooks(newBook).Sheets(i).Select 'after:=Workbooks(newBookName).Sheets(i)
                Next i

                ' Remove default sheets
                Application.DisplayAlerts = False   ' Ensure no prompts when deleting tabs with data inside
                For i = 1 To 3
                    Workbooks(newBookName).Sheets(1).Delete
                Next i
                Application.DisplayAlerts = True    ' Turn on prompts again

   

End Sub

标签: excelvba

解决方案


推荐阅读