将工作表和文件名编译到工作簿中答案

【问题标题】：Compile sheets and file names into workbook将工作表和文件名编译到工作簿中
【发布时间】：2017-08-16 03:48:55
【问题描述】：

我有一个主 Excel 文件，它将用作从文件夹中不同 Excel 文件的不同工作表名称中获取数据的参考，

我已经搜索了网络，但无法找到解决方案。有没有办法获取所有工作表名称并从 A2 和 A1 开始每行粘贴它，这将反映其文件名而不带扩展名？

这是我目前所拥有的：

Sub SheetNames()

    Columns(1).Insert
    For I = 1 To Sheets.Count
        Cells(I, 1) = Sheets(I).Name
    Next I
End Sub

【问题讨论】：

也许this SO question给你一些代码灵感。
Jeroen - 主要目标是获取所有文件名及其工作表名称。例如，一个文件夹中有 4 个文件，它们的文件应按列复制并放置到主文件中，每行各自的工作表名称 A1 = 文件名 1 A2 = Sheet1 A3 = Sheet2 A4 = Sheet3 谢谢！

标签： excel vba automation filenames worksheet

【解决方案1】：

你可以试试这个代码。它会将所有内容保存在主工作簿的第一张表中：

Sub SheetNames()

Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim currentWorkbook, wb As Workbook
Dim i, j As Integer

Set currentWorkbook = ActiveWorkbook

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the current folder object
Set objFolder = objFSO.GetFolder(currentWorkbook.Path)
i = 1
j = 2
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
'we filter filenames, so we get only excel files
'note that second condition is to prevent from using cached workbook associated with opened workbook
'it starts with ~$
If objFile.Name Like "*.xlsx" And Not objFile.Name Like "~$*.xlsx" _
And Not objFile.Name = currentWorkbook.Name Then
    'get the name of a workbook in the first row
        currentWorkbook.Worksheets(1).Cells(1, i).Value = objFile.Name
        'open workbook
        Set wb = Workbooks.Open(currentWorkbook.Path & "/" & objFile.Name)
        'loop through sheets and get their names into cells
        For j = 2 To wb.Worksheets.Count + 1
            currentWorkbook.Worksheets(1).Cells(j, i).Value = wb.Worksheets(j - 1).Name
        Next
        'close workbook without saving changes
        wb.Close (False)
        i = i + 1

    End If

Next objFile

End Sub

【讨论】：