工作中，我们有时会需要将多个工作表Sheet的名称提取出来，制作成一个目录
 如果一个一个去复制粘贴，效率肯定是很低的，如果Sheet数量很多，会严重影响我们的工作进度，那该如何处理呢？
 
我们可以用VBA的方法快速处理
 
步骤：
 
Step1: 首先调出【开发工具】选项卡，单击【文件】选项卡-【选项】-【自定义功能区】，在主选项卡中，把【开发工具】前面的“√”选上，然后确定即可
 

 Step2：单击 【开发工具】选项卡，在“代码”选项组中选择“Visual Basic”，弹出【模块代码】编辑框，选择Microsoft Excel 对象，然后单击【插入】选项卡，选择【模块】，然后把写好的宏放在右边的编辑框里，然后把代码编辑框关掉
 

 VBA代码如下：
 
Sub 提取工作表名称()
 Dim i!
 Cells(1, 1).Value = “表名”
 For i = 1 To Sheets.Count
 Cells(i + 1, 1).Value = Sheets(i).Name
 Next i
 End Sub
 
Step3：单击Excel中的【插入】选项卡，单击【形状】按钮，随便选择一个文本框，然后输入文字，单击文本框，鼠标右键，选择【指定宏】选项，选择刚才编辑的宏，然后确定即可，当我们单击“提取工作表的名称”按钮时，在A列就会看到每个表的名称都提取出来了
 

 不会VBA也可以快速提取
 欢迎关注和转发
 
 
END

'批量取工作表名称
Function gname(x As Integer)
	If x = 0 Then
		gname = ActiveSheet.Name
	ElseIf x > 0 And x <= Sheets.Count Then
		gname = Sheets(x).Name
	ElseIf x > Sheets.Count Then
		MsgBox "超出范围"
	End If
Application.Volatile
End Function

学习日志
 
复制指定目录下excel工作簿中同名工作表，该代码将在相同目录下创建汇总工作簿，各工作簿中同名工作表将被分别复制到汇总工作簿的不同表中（汇总工作簿中各工作表以分工作簿名命名）。
 所有要汇总的工作簿在同一个文件夹中，这里以后缀为.xlsx为例；
 
ALL excelfiles
 
Sub allexclefiles()
    Dim path As String, filename As String
    Dim w As Workbook, ws As Workbook
    
    path = "C:\12"
    filename = Dir(path & "\*.xlsx")
    'ws工作簿保存所有单位excel表格花名册
    
    '关闭提示
    Application.DisplayAlerts = False
    Set ws = Workbooks.Add
    
    Do While filename <> ""
        'w代表指定文件夹下每个找到的excel文件
        Set w = Workbooks.Open(path & "\" & filename)
            '选择工作表（此处假设sheet1），复制，并粘贴为汇总表的最后一张
            w.Sheets("sheet1").Copy after:=ws.Sheets(ws.Sheets.Count)
             '重命名刚贴的表名为excel文件名
            ws.Worksheets(ws.Sheets.Count).name = Mid(filename, 1, Len(filename) - 5)

        '关闭工作簿
        w.Close
        '下一个
        filename = Dir
    Loop
'程序运行结束，打开提示
    Application.DisplayAlerts = True
'保存结果
ws.SaveAs path & "\汇总.xlsx"
End Sub

保存指定工作表为工作簿文件
 
1、指定的单一工作表
 
如果需要将工作簿中的工作表单独保存为一个工作簿文件，可以使用 Worksheet 对象的 Copy 方法，将指定的工作表复制到一个新建的工作簿。
 
Sub test()
    On Error GoTo line
    ActiveSheet.Copy  '复制工作表为工作簿
    ActiveWorkbook.Close savechanges:=True, Filename:="d:\123.xlsx" '保存当前工作簿即可
    Exit Sub
line:
    ActiveWorkbook.Close False
End Sub
 
2、所有工作表保存为工作簿
 
'方法一：
Sub test1()
    Application.ScreenUpdating = False '屏幕不更新
    Dim i As Integer
    Dim j As Integer
    Dim str As String
    j = Worksheets.Count
    For i = j To 1 Step -1
        Worksheets(i).Copy
    	str = ActiveWorkbook.Sheets(1).Name   '将工作簿名称改为工作表名称
        ActiveWorkbook.SaveAs Filename:="D:\data\" & str & ".xlsx"
        ActiveWorkbook.Close savechanges:=True
    Next
	Application.ScreenUpdating = True
End Sub

'方法二:
Sub test()
Dim sht As Worksheet
Application.ScreenUpdating = False
For Each sht In Sheets
    sht.Copy
    ActiveWorkbook.SaveAs Filename:="d:\data\" & sht.Name & ".xlsx"
    ActiveWorkbook.Close
Next
Application.ScreenUpdating = True
End Sub