Question

我有一个主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

Answer 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

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

1 个答案: