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

主程序代码 主程序代码 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 弹出对话框获取路径的弹出对话框获取路径的 GetPatchGetPatch 过程代码过程代码 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 source Name Len source Name 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 Worksh