2 个答案:

答案 0 :(得分：3)

像这样 -

Sub SaveSheet()

Dim wbkDashboard As Workbook

Dim wsTarget As Worksheet

Set wsTarget = Thisworkbook.worksheets("Sheet1")

Dim strFileName As String

strFileName = wsTarget.Range("B8").Value _

& Format(Now, "ddmmyyyy") & "-" & Environ("username") & ".xlsx"

Set wbkDashboard = Workbooks.Add

wsTarget .Copy Before:=wbkDashboard.Sheets(1)

For intSheetCount = 2 To wbkDashboard.Sheets.Count

wbkDashboard.Sheets(2).Delete

Next

wbkDashboard.SaveAs "W:\Test\" & wsTarget.Range("B8").Value _

& Format(Now, "ddmmyyyy") & "-" & Environ("username") & ".xlsx"

wbkDashboard.Close

wsTarget.Range("B8").Value= strFileName

Set wsTarget = Nothing

Set wbkDashboard = Nothing

End Sub

答案 1 :(得分：2)

此代码将保存您在当前版本中创建的所有更改，然后它将仅将活动工作表保存为具有用户名和日期的新工作簿(感谢@Will on the Environment Variables)。

Sub Saveworkbook()

Application.DisplayAlerts = False

Dim Sheet1 As Worksheet

Dim dName$, vName$, sName$

dName = Range("B8")

vName = ActiveWorkbook.FullName

sName = ActiveWorkbook.ActiveSheet.Name

For Each Sheet1 In ActiveWorkbook.Sheets

If Not Sheet1.Name = sName Then

Sheet1.Delete

End If

Next Sheet1

ActiveWorkbook.SaveAs "W:\Test\" & dName & "_" & Environ("username") & "_" & Format(Now, "ddmmyy") & "xlsx"

ActiveWorkbook.Close

Application.DisplayAlerts = True

End Sub