Excel合并多个工作表

参考链接：https://blog.csdn.net/weixin_43144634/article/details/82689732

合并文件夹下各文件

Private Sub hb()
    Dim hb As Object, kOne As Boolean, tabcolor As Long
    Set hb = Workbooks.Add
    Application.DisplayAlerts = False
    For I = hb.Sheets.Count To 2 Step -1
        hb.Sheets(I).Delete
    Next
     
    Dim FileName As String, FilePath As String
    Dim iFolder As Object, rwk As Object, Sh As Object
    Set iFolder = CreateObject("shell.application").BrowseForFolder(0, "请选择要合并的文件夹", 0, "")
    If iFolder Is Nothing Then Exit Sub
    FilePath = iFolder.Items.Item.Path
    FilePath = IIf(Right(FilePath, 1) = "\", FilePath, FilePath & "\")
    FileName = Dir(FilePath & "*.xls*")
    Do Until Len(FileName) = 0
        If UCase(FilePath & FileName) <> UCase(ThisWorkbook.Path & "\" & ThisWorkbook.Name) Then
            Set rwk = Workbooks.Open(FileName:=FilePath & FileName)
            tabcolor = Int(Rnd * 56) + 1
            With rwk
                For Each Sh In .Worksheets
                    Sh.Copy After:=hb.Sheets(hb.Sheets.Count)
                    hb.Sheets(hb.Sheets.Count).Name = "小学" & "-" & Sh.Name & "-" & FileName
                    hb.Sheets(hb.Sheets.Count).Tab.ColorIndex = tabcolor
                    If Not kOne Then hb.Sheets(1).Delete: kOne = True
                Next
                .Close True
             End With
        End If
        Set rwk = Nothing
        FileName = Dir
    Loop
    Application.DisplayAlerts = True
    'Sort_Sheets
    
End Sub

 

Sheet排序

Sub Sort_Sheets()
Dim sCount As Integer, I As Integer, R As Integer
ReDim Na(0) As String    '声明数组Na
sCount = Sheets.Count   '统计工作表数量。
'------------收集所有工作表名称代码段--------------
For I = 1 To sCount
    ReDim Preserve Na(I) As String 'Na被声明为动态数组，数组元素个数随I值发化变化
    Na(I) = Sheets(I).Name   '将第I个工作表名称存入数组
Next
'------------在数组中对名称进行排序-----------------
For I = 1 To sCount - 1 '从1到工作表数-1
    For R = I + 1 To sCount '从i+1到工作表数
        If Na(R) < Na(I) Then '若Na(R)<Na(i),将相邻两个数组元素(工作表名称)比较大小。文本也可比大小！
            JH = Na(I) '本句和接下来两句，将Na(I)与Na(R)内容互换
            Na(I) = Na(R)
            Na(R) = JH
        End If
    Next
Next
'------------根据数组中排好的顺序，将相应工作表移到最后-------完成排序
For I = 1 To sCount  '
    Sheets(Na(I)).Move After:=Sheets(I)
Next
End Sub

 

删除无用sheet

'删除名字前三个字符为“sht”的所有工作表
Public Sub delectsh()
    Dim c As Worksheet
    For Each c In Worksheets
         If c.Name like "sht*" Then'这里的“sht”区分大小写
             Application.DisplayAlerts = False'删除时不用确认
             c.Delete
         End If
         
    Next c
End Sub