VB求助~如何将文件夹中的多个工作表的sheet1合并到同一个工作表中

时间:2021-04-04 15:08:31
如题:
如何将文件夹中的多个工作表的sheet1合并到同一个工作表中
最后生成的总表根据查找的工作表数量sheet1自动递增(sheet2.sheet3......sheetN)
求高手帮助

3 个解决方案

#1


请参考以下代码进行修改
'取得该目录下的所有excel文件(包括子目录)
Sub getFolder(strPath As String)
Dim fileCount As Integer
Dim subPath As String
'目录列表
Dim folderList(1000) As String
'目录列表下标
Dim folderCount As Integer
Dim fileList(1000) As String
folderCount = 0
Dim i As Long
'取得目录和文件信息
subPath = Dir(strPath & "\", vbDirectory)

Do While subPath <> ""

    '除去上层目录
    If subPath <> "." And subPath <> ".." Then
    
        '如果是目录就加入目录列表
        If GetAttr(strPath & "\" & subPath) = vbDirectory Then
        
            folderList(folderCount) = strPath & "\" & subPath
            Debug.Print folderList(folderCount)
            folderCount = folderCount + 1
            
        '如果是excel文件就加入文件列表
        ElseIf InStr(Right(subPath, 4), "xls") > 0 Then
        
            fileList(fileCount) = strPath & "\" & subPath
            Debug.Print fileList(fileCount)
            fileCount = fileCount + 1
        
        End If
    
    End If
    '取下一个目录或文件
    subPath = Dir
Loop

'如果该目录下还有子目录
If folderCount > 0 Then

    For i = 0 To folderCount - 1
        
        getFolder (folderList(i))
    
    Next i

End If


End Sub

#2


能不能提示下,太菜了,有点不明白

#3


不是“太菜”,而是“太懒”了

#1


请参考以下代码进行修改
'取得该目录下的所有excel文件(包括子目录)
Sub getFolder(strPath As String)
Dim fileCount As Integer
Dim subPath As String
'目录列表
Dim folderList(1000) As String
'目录列表下标
Dim folderCount As Integer
Dim fileList(1000) As String
folderCount = 0
Dim i As Long
'取得目录和文件信息
subPath = Dir(strPath & "\", vbDirectory)

Do While subPath <> ""

    '除去上层目录
    If subPath <> "." And subPath <> ".." Then
    
        '如果是目录就加入目录列表
        If GetAttr(strPath & "\" & subPath) = vbDirectory Then
        
            folderList(folderCount) = strPath & "\" & subPath
            Debug.Print folderList(folderCount)
            folderCount = folderCount + 1
            
        '如果是excel文件就加入文件列表
        ElseIf InStr(Right(subPath, 4), "xls") > 0 Then
        
            fileList(fileCount) = strPath & "\" & subPath
            Debug.Print fileList(fileCount)
            fileCount = fileCount + 1
        
        End If
    
    End If
    '取下一个目录或文件
    subPath = Dir
Loop

'如果该目录下还有子目录
If folderCount > 0 Then

    For i = 0 To folderCount - 1
        
        getFolder (folderList(i))
    
    Next i

End If


End Sub

#2


能不能提示下,太菜了,有点不明白

#3


不是“太菜”,而是“太懒”了