求vba高手:用宏修改工作簿中工作表的名称
Sub每个工作表另存为单独的工作簿()DimshtAsWorksheetApplication.ScreenUpdating=Falseipath=ThisWorkboo...
Sub 每个工作表另存为单独的工作簿()
Dim sht As Worksheet
Application.ScreenUpdating = False
ipath = ThisWorkbook.Path & "\" '(保存路径为当前工作簿所在路径)
For Each sht In Sheets
sht.Copy
ActiveWorkbook.SaveAs ipath & sht.Name & ".xls" '(工作表名称为文件名)
ActiveWorkbook.Close
Next
Application.ScreenUpdating = True
End Sub
这个宏是把一个工作簿中的工作表拆分为工作簿的宏,工作簿的名称是之前工作表的,现在还需要让新生成的工作簿中工作表的名称固定,如“工资”等。谢谢。 展开
Dim sht As Worksheet
Application.ScreenUpdating = False
ipath = ThisWorkbook.Path & "\" '(保存路径为当前工作簿所在路径)
For Each sht In Sheets
sht.Copy
ActiveWorkbook.SaveAs ipath & sht.Name & ".xls" '(工作表名称为文件名)
ActiveWorkbook.Close
Next
Application.ScreenUpdating = True
End Sub
这个宏是把一个工作簿中的工作表拆分为工作簿的宏,工作簿的名称是之前工作表的,现在还需要让新生成的工作簿中工作表的名称固定,如“工资”等。谢谢。 展开
3个回答
展开全部
Dim sht As Worksheet
Set xlApp = CreateObject("Excel.Application")
Application.ScreenUpdating = False
ipath = ThisWorkbook.Path & "\"
For Each sht In Sheets
sht.Copy
strFileNm = ipath & sht.Name & ".xls"
ActiveWorkbook.SaveAs strFileNm
ActiveWorkbook.Close
Set wb = xlApp.Workbooks.Open(strFileNm, False, False)
Set ws = wb.Worksheets(1)
wb.Worksheets(1).Name = "工资"
wb.Close savechanges:=True
Next
xlApp.Quit: Set xlApp = Nothing
Application.ScreenUpdating = True
Set xlApp = CreateObject("Excel.Application")
Application.ScreenUpdating = False
ipath = ThisWorkbook.Path & "\"
For Each sht In Sheets
sht.Copy
strFileNm = ipath & sht.Name & ".xls"
ActiveWorkbook.SaveAs strFileNm
ActiveWorkbook.Close
Set wb = xlApp.Workbooks.Open(strFileNm, False, False)
Set ws = wb.Worksheets(1)
wb.Worksheets(1).Name = "工资"
wb.Close savechanges:=True
Next
xlApp.Quit: Set xlApp = Nothing
Application.ScreenUpdating = True
展开全部
Sub 每个工作表另存为单独的工作簿()
Dim sht As Worksheet
Dim s1 As String
Application.ScreenUpdating = False
ipath = ThisWorkbook.Path & "\" '(保存路径为当前工作簿所在路径)
For Each sht In Sheets
s1 = sht.Name
sht.Name = "工资"
sht.Copy
ActiveWorkbook.SaveAs ipath & s1 & ".xlsx"
sht.Name = s1
ActiveWorkbook.Close
Next
Application.ScreenUpdating = True
End Sub
Dim sht As Worksheet
Dim s1 As String
Application.ScreenUpdating = False
ipath = ThisWorkbook.Path & "\" '(保存路径为当前工作簿所在路径)
For Each sht In Sheets
s1 = sht.Name
sht.Name = "工资"
sht.Copy
ActiveWorkbook.SaveAs ipath & s1 & ".xlsx"
sht.Name = s1
ActiveWorkbook.Close
Next
Application.ScreenUpdating = True
End Sub
追问
太感谢您了,就是这个效果,不过在麻烦您一下,我表中有很多来源于表外的链接,我想断开这些链接,但表内的公式都保留上,谢谢您。
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询