Excel VBA提取工作表名称
- 格式：doc
- 大小：85.50 KB
- 文档页数：5
VBA提取工作薄内所有工作表名称
处理Excel工作薄的工作表时，如果工作表数量较多，怎样将所有工作表名称提取出来，便于以后修改、删除工作表？VBA代码能快速处理。
1、同一工作薄内所有工作表名称，提取到指定工作表的指定位置（如工作表“Sheet1”A列），代码如下：
Dim SheetsName As Integer
For SheetsName = 1 To Worksheets.Count
Sheets("Sheet1").Cells(SheetsName, 1).Value =
Worksheets(SheetsName).Name Next
2、同一工作薄内所有工作表名称提取到新建工作表内，如新建工作表名称“目录”。应先判断有无名为“目录”工作表，并将新建工作表放在指定位置，如所有的工作表最后面、最前面、某个工作表前或后、所有工作表序列几号的位置等。代码如下：
Dim SheetActive As Worksheet
Dim NewSheet As Worksheet
Dim Sheet As Worksheet
Dim SheetsNumb As Integer
Dim ActiveSheet As Worksheet
Dim ActiveSheetsName As String
Dim i As Integer
ActiveSheetsName = "目录"
On Error Resume Next '代码出错时继续运行
Set SheetActive = ActiveSheet '确定活动单元格名称
i = 0
For Each Sheet In Worksheets
If = ActiveSheetsName Then '遍历工作表，判断有无"目录"工作表名称，若有,变量赋值变化。
i = 1
Exit For
End If
Next
If i <> 1 Then '若无指定工作表，则新建工作表
' Set NewSheet =
ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)) '新建工作表放在最后
Set NewSheet =
ThisWorkbook.Sheets.Add(Before:=ThisWorkbook.Sheets(1))
'新建工作表放在最前面
= ActiveSheetsName
End If
For SheetsNumb = 1 To Worksheets.Count
Sheets(ActiveSheetsName).Cells(SheetsNumb, 1).Value
= Worksheets(SheetsNumb).Name '提取工作表名称放在目标工作表A例
Next
Sheets(ActiveSheetsName).Activate '设置活动工作表
3、提取同一文件夹、不同工作薄内的所有工作表名称，如提取同一文件夹内工作薄名为“出入库清单”内的所有工作表名称，代码如下：
Dim YPath As String
Dim folderPath As String
Dim fname As String
Dim fPath As String
Dim MWorkbook As String
Dim Mxls As String
Dim MPath As String
Dim i As Integer
Dim wb As Workbook
folderPath = Application.ActiveWorkbook.Path '提取当前工作薄路径
fname = '提取当前工作表名称
fPath = Replace(folderPath, fname, "") '替换工作薄名称，取得同一文件夹的路径
MPath = fPath + "\" + MWorkbook + Mxls '合成需操作工作江薄的总路径
MWorkbook = "出入库清单"
Mxls = ".xls"
'打开指定路径下的工作表 Workbooks.Open Filename:=fPath + "\" + MWorkbook + Mxls
Windows(MWorkbook & Mxls).Activate
Dim MSheetName() As Variant
Dim Sheet As Worksheet
Dim SheetNumb As Integer
Dim j As Integer
i = 0
j = 0
Dim SheetName As String
Dim SheetLength As Integer
SheetNumb = Sheets.Count
ReDim MSheetName(SheetNumb)
For Each Sheet In Worksheets
MSheetName(i) =
i = i + 1
Next
Workbooks(MWorkbook & Mxls).Close
Cells(1, 1) = MWorkbook & Mxls & "内工作表有"
For j = 0 To i
Cells(j + 2, 1) = MSheetName(j)
Next
