Sub 拆分工作簿并命名() Dim mypath As String Dim sh As Worksheet Dim file_name As String mypath = ThisWorkbook.Path For Each sh In Worksheets sh.Copy '这条语句会复制工作表并放在一个新建工作簿 file_name = ActiveWorkbook.Worksheets(1).Range("a1") '连接时 & 符号前面要加一个空格 ActiveWorkbook.SaveAs mypath & "\" & file_name & ".xlsx" ActiveWorkbook.Close True Next End Sub