秋梦无痕

描述：
工作需要，把一堆excel文件(xslx)合并为一个文件。
于是写了一个VB Application。
需要者请自取。

Sub CombineSheets()
    Dim dlgFileDialog As FileDialog
    Set dlgFileDialog = Application.FileDialog(msoFileDialogFilePicker)
    
    Dim newWorkbook As Workbook
    Set newWorkbook = Workbooks.Add
    
    With dlgFileDialog
        ; 选择多个文件
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xls;*.xlsx"
        .Filters.Add "All Files", "*.*"
        
        If .Show = -1 Then
            Dim vrtSelectedItem As Variant
            
            Dim i As Integer
            i = 1

            For Each vrtSelectedItem In .SelectedItems
                Dim tmpWorkbook As Workbook
                Set tmpWorkbook = Workbooks.Open(vrtSelectedItem)

                If tmpWorkbook.Worksheets.Count = 1 Then
                    ;如果源文件里面只有一个Sheet，在新excel文件里面的Sheet名为文件名
                    tmpWorkbook.Worksheets(1).Copy Before:=newWorkbook.Worksheets(i)
                    newWorkbook.Worksheets(i).Name = VBA.Replace(tmpWorkbook.Name, ".xlsx", "")
                    i = i + 1
                ElseIf tmpWorkbook.Worksheets.Count > 1 Then
                    ; 如果源文件里面有多个Sheet，在新excel文件里面的Sheet名为"文件名(第几个Sheet)"
                    Dim tmpWorkSheet As Worksheet
                    
                    Dim j As Integer
                    j = 1
                    
                    For Each tmpWorkSheet In tmpWorkbook.Worksheets
                        tmpWorkSheet.Copy Before:=newWorkbook.Worksheets(i)
                        newWorkbook.Worksheets(i).Name = VBA.Replace(tmpWorkbook.Name, ".xlsx", "(" & j & ")")
                        i = i + 1
                        j = j + 1
                    Next tmpWorkSheet
                End If
                tmpWorkbook.Close SaveChanges:=False
            Next vrtSelectedItem
        End If
    End With

    Set dlgFileDialog = Nothing
End Sub