Sub Books2Sheets()     ‘定义对话框变量      Application.ScreenUpdating = False     Dim fd As FileDialog     Set fd = Application.FileDialog(msoFileDialogFilePicker)          ‘新建一个工作簿     Dim newwb As Workbook     Set newwb = Workbooks.Add          With fd         If .Show = -1 Then             ‘定义单个文件变量            Dim vrtSelectedItem As Variant                          ‘定义循环变量            Dim i As Integer             i = 1                          ‘开始文件检索            For Each vrtSelectedItem In .SelectedItems                 ‘打开被合并工作簿                Dim tempwb As Workbook                 Set tempwb = Workbooks.Open(vrtSelectedItem)                                  ‘复制工作表                tempwb.Worksheets(1).Copy Before:=newwb.Worksheets(i)                                  ‘把新工作簿的工作表名字改成被复制工作簿文件名，这儿应用于xls文件，即Excel97-2003的文件，如果是Excel2007，需要改成xlsx                 newwb.Worksheets(i).Name = VBA.Replace(tempwb.Name, ".xls", "")                                  ‘关闭被合并工作簿                tempwb.Close SaveChanges:=False                                  i = i + 1             Next vrtSelectedItem         End If     End With     Set fd = Nothing     Sheets("Sheet1").Select     Sheets("Sheet1").Name = "汇总"     MsgBox "现在已经过个工作簿中的sheet表合并到了一个工作簿中，现在开始将相同格式的工作表合并到一个sheet表中"     Sheets("汇总").Select     Call NsheetsTo1sheet     Application.ScreenUpdating = True End Sub Sub NsheetsTo1sheet() Application.ScreenUpdating = False For j = 1 To Sheets.Count If Sheets(j).Name <> ActiveSheet.Name Then X = Range("A65536").End(xlUp).Row + 1 Sheets(j).UsedRange.Copy Cells(X, 1) End If Next Range("B1").Select Application.ScreenUpdating = True MsgBox "当前工作簿下的全部工作表已经合并完毕！", vbInformation, "提示" End Sub