二级计算机excel以宏保存,Excel宏保存

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

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值