相同格式电子表格数据汇总

主程序代码：

Sub ins_sheet()

'获取汇总后的xls文件的路径

Dim patch As String

patch = GetPatch()

If patch = "" Then

Exit Sub

End If

'获取文件夹对象

Dim myfilesystem As Object

Set myfilesystem = _

CreateObject("Scripting.FileSystemObject")

Dim aimFolder As Folder

Set aimFolder = myfilesystem.GetFolder(patch)

'复制指定文件夹下的xls文件

For Each one In aimFolder.Files

If one.Type = "Microsoft Excel 工作表" Then

MyCopy (one.path)

End If

Next one

End Sub

'弹出对话框获取路径的GetPatch过程代码

Function GetPatch() As String

'调用文件选取对话框

Dim fd As FileDialog

Set fd = Application.FileDialog(msoFileDialogFolderPicker) Dim result As Integer

With fd

.AllowMultiSelect = False

'显示对话框

result = .Show()

If result <> 0 Then

'返回用户选择的路径

GetPatch = fd.SelectedItems(1)

Else

GetPatch = ""

End If

End With

Set fd = Nothing

End Function

'将指定路径下的工作簿中的所有工作表复制到当前工作簿中的过程

Sub MyCopy(path As String)

Application.ScreenUpdating = False

Application.DisplayAlert = False

'获取目标工作簿

On Error GoTo err

Workbooks.Open (path)

Dim source As Workbook

Set source = ActiveWorkbook

'循环访问该工作簿的所有工作表

Dim index As Integer

For index = 1 To source.Worksheets.Count

'复制该工作表到当前工作簿中

source.Worksheets(index).Copy Before:=ThisWorkbook.Worksheets(1)

'用各人的姓名作为工作表名

ThisWorkbook.Worksheets(1).Name = Left(, Len() - 4) Next index

source.Close

Application.ScreenUpdating = True

Application.DisplayAlert = True

Exit Sub

err:

End Sub

'以记录方式合并工作表数据到同一工作表中。

Sub hbjl()

Dim i, j As Integer, icount As Integer

'统计需要合并的工作表最大index

icount = Worksheets.Count - 1

Worksheets("合并为记录").Select

i = 3

For j = 2 To icount

Worksheets("合并为记录").Cells(i, 1) = Worksheets(j).Cells(2, 2) Worksheets("合并为记录").Cells(i, 2) = Worksheets(j).Cells(2, 4) Worksheets("合并为记录").Cells(i, 3) = Worksheets(j).Cells(2, 6) Worksheets("合并为记录").Cells(i, 4) = Worksheets(j).Cells(3, 2) Worksheets("合并为记录").Cells(i, 5) = Worksheets(j).Cells(3, 4) Worksheets("合并为记录").Cells(i, 6) = Worksheets(j).Cells(3, 6) Worksheets("合并为记录").Cells(i, 7) = Worksheets(j).Cells(4, 2) Worksheets("合并为记录").Cells(i, 8) = Worksheets(j).Cells(4, 4) Worksheets("合并为记录").Cells(i, 9) = Worksheets(j).Cells(4, 6) Worksheets("合并为记录").Cells(i, 10) = Worksheets(j).Cells(5, 2) Worksheets("合并为记录").Cells(i, 11) = Worksheets(j).Cells(7, 1) Worksheets("合并为记录").Cells(i, 12) = Worksheets(j).Cells(9, 1) i = i + 1

Next j

'统计汇总结果

MsgBox "一共成功合并了" + Str(icount) + "个教工的表格数据！"