合并EXCEL文档宏

合并EXCEL文档宏

'使用本宏前，需要先在“工具”-“引用”中把“Microsoft Script Runtime\"勾上

Sub test()

Dim fso As New FileSystemObject, sFolder As Folder, sFile As File, sPath As String

Dim excel As New excel.Application

Dim sBook As Workbook, sSheet As Worksheet, sRange As Range, mSheet As Worksheet, mRange As Range

Dim cRow As Long, headed As Boolean

sPath = \"C:\\Users\\mxw\\Desktop\\新建文件夹\\\" '分表所在文件夹路径

Set sFolder = fso.GetFolder(sPath)

Set mSheet = ActiveWorkbook.Sheets(\"Sheet1\")

'mSheet.Cells.Clear '清空总表

'excel.Visible = True '显示 Excel 窗口

ScreenUpdating = False

For Each sFile In sFolder.Files

If Right(sFile.Name, 5) = \".xlsx\" Or Right(sFile.Name, 4) = \".xls\" And sFile <> ActiveWorkbook.FullName Then '后一条件考虑总表和分表文件可能在同一文件夹

Set sBook = excel.Workbooks.Open(sPath & sFile.Name)

Set sSheet = sBook.Sheets(2)

'If Not headed Then

'Set sRange = sSheet.UsedRange

'mSheet.Range(Cells(1, 1), Cells(1, sRange.Columns.Count)).Value =

sRange.Rows(1).Value '总表题头 = 分表题头

'headed = True

'End If

Set sRange = sSheet.UsedRange

Set sRange = sSheet.Range(\"A4:EJ4\") '只合并第四行

Set mRange = mSheet.UsedRange

cRow = mRange.Rows.Count + mRange.Row

mSheet.Range(Cells(cRow, 1), Cells(sRange.Rows.Count + cRow - 1, sRange.Columns.Count)).Value = sRange.Value

sBook.Close

End If

Next sFile

ScreenUpdating = True

excel.Quit

Set excel = Nothing

Set fso = Nothing

MsgBox \"Finished!\"

End Sub