可以写宏来做,以下是一段代码,用来合并文件Sub 复制工作表() Dim MyObject As Object Dim strPath As String, strFileName As String, strMyName As String Dim shtSheet As Worksheet, strShtName As String Dim intCount As Integer, intShtCount As Integer, i As Integer Application.ScreenUpdating = False strPath = ThisWorkbook.Path strMyName = ThisWorkbook.Name intShtCount = ThisWorkbook.Sheets.Count With Application.FileSearch .NewSearch .LookIn = strPath .SearchSubFolders = False .Filename = ".xls" .FileType = msoFileTypeOfficeFiles If .Execute() > 0 Then intCount = .FoundFiles.Count For i = 1 To intCount strFileName = Replace(.FoundFiles(i), strPath & "\", "") If strFileName <> strMyName Then Set MyObject = GetObject(strPath & "/" & strFileName) '下面进行复制工作 For Each shtSheet In MyObject.Worksheets strShtName = shtSheet.Name If MyObject.Sheets(strShtName).UsedRange.Count > 1 Then MyObject.Sheets(strShtName).copy After:=ThisWorkbook.Sheets(intShtCount) intShtCount = intShtCount + 1 '重新命名 strShtName = Replace(strFileName, ".xls", "_") & strShtName 'change by Tony strShtName = "Sheet" & intShtCount ThisWorkbook.Sheets(intShtCount).Name = strShtName ThisWorkbook.Sheets("目录").Cells(i + 1, 1) = strShtName End If Next shtSheet End If Next i Else MsgBox "没有找到符合指定文件，请修改参数后重新搜索！", , "笔锋侠实用工具系列-批量修改文件名 V1.0" End If End With ThisWorkbook.Sheets("目录").Select Application.ScreenUpdating = TrueEnd Sub点击工具->宏->宏 取个名字点创建,复制以上代码,然后把要合并的excel文件和本文件放在一个文件夹,之后运行这个宏,就可以了.