宏代码-合并工作表.doc

宏代码工作表合并一、关于宏的EXCEL设置1.设置快捷宏图标：文件EXCEL选项-常用-在功能区显示“开发工具”选项卡打钩2.删除宏：宏-选中相应的宏-删除3.取消出现安全隐私警告：EXCEL选项-信任中心-信任中心设置-个人信息选项-将”保存时从文件属性中删除个人信息“前面的勾去掉二、合并当前工作簿下的所有工作表1.我们现在开始合并，首先要在最前页新建一个工作表。如图：步骤阅读2.在新建的sheet表中“右键”，找到“查看代码”，然后看到宏计算界面。如图所示：步骤阅读步骤阅读看到宏计算界面，我们就只需要把下面的代码复制进去，代码如下，效果如下：Sub 合并当前工作簿下的所有工作表()Application.ScreenUpdating = FalseFor 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 IfNextRange(B1).SelectApplication.ScreenUpdating = TrueMsgBox 当前工作簿下的全部工作表已经合并完毕！, vbInformation, 提示End Sub或者如下：Sub合并() ForI=2ToSheets.Count 如果工作表的第一行都一样，就把下Rows(1&的1改成2就好了Sheets(I).Rows(1&:&Sheets(I).Range(A60000).End(xlUp).Row)._CopyRange(A&Range(A60000).End(xlUp).Row+1)NextEndSub步骤阅读1. 53.点击工具栏上面的“运行”下的“运行子过程/用户窗体”就可以了，合并完之后会有提示。提示完成之后就可以把宏计算界面关闭了。如图所示：步骤阅读4.合并完成后记得删除宏，详细操作见一5.删除多余的首行标题：工作表全选自动筛选选择列（建议选择文本选项少的列）-勾选重复的标题与空白删除重复标题与空白三、合并当前目录下所有工作簿的全部工作表1.我们需要把多个excel表都放在同一个文件夹里面，并在这个文件夹里面新建一个excel。如图所示： 步骤阅读2.用microsoft excel打开新建的excel表，并右键单击sheet1，找到“查看代码”，单击进去。进去之后就看到了宏计算界面。如图所示：步骤阅读步骤阅读3.然后我们把下面这些宏计算的代码复制进去（注意XLS或者XLSX），代码如下，如图所示：Sub 合并当前目录下所有工作簿的全部工作表()Dim MyPath, MyName, AWbNameDim Wb As Workbook, WbN As StringDim G As LongDim Num As LongDim BOX As StringApplication.ScreenUpdating = FalseMyPath = ActiveWorkbook.PathMyName = Dir(MyPath & & *.xls)AWbName = ActiveWorkbook.NameNum = 0Do While MyName If MyName AWbName ThenSet Wb = Workbooks.Open(MyPath & & MyName)Num = Num + 1With Workbooks(1).ActiveSheet.Cells(.Range(B65536).End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)For G = 1 To Sheets.CountWb.Sheets(G).UsedRange.Copy .Cells(.Range(B65536).End(xlUp).Row + 1, 1)NextWbN = WbN & Chr(13) & Wb.NameWb.Close FalseEnd WithEnd IfMyName = DirLoopRange(B1).SelectApplication.ScreenUpdating = TrueMsgBox 共合并了 & Num & 个工作薄下的全部工作表。如下： & Chr(13) & WbN, vbInformation, 提示End Sub步骤阅读4. 然后找到工具栏上面的“运行”下的“运行子过程/用户窗体”步骤阅读5.合并完成后记得删除宏，详细操作见一6.删除多余的首行标题：工作表全选自动筛选选择列（建议选择文本选项少的列）-勾选重复的标题与空白删除重复标题与空白四、多个Excel工作簿的第一个工作表合并成一个新的工作簿1、将需要合并的excel工作簿文件放置在一个文件夹中。2、在该文件夹中，新建立一个新的excel工作簿文件。3、打开新建立的excel工作簿文件，将鼠标移动到下方工作表名称sheet1上右键，选择查看代码。4、在弹出的代码编辑窗口中，输入代码。5、在代码窗口中，粘贴下列代码：Private Sub 合并工作薄() Dim f_name As String Dim bok1 As Workbook, bok2 As Workbook Set bok2 = Nothing f_name = Dir(ThisWorkbook.Path & *.*) 获得该目录下的所有EXCEL文件 Do While f_name 开始执行循环 If f_name ThisWorkbook.Name Then 如果当前的文件不是代码所在文件，执行合并操作 Set bok1 = Workbooks.Open(ThisWorkbook.Path & & f_name) 打开被合并的文件 If bok2 Is Nothing Then 合并后的文件是否存在 bok1.Sheets(1).Copy 如果合并后的文件不存在，则创建一个 Set bok2 = ActiveWorkbook Else bok1.Sheets(1).Copy Before:=bok2.Sheets(1) 如果合并后的文件存在，则将被合并文件的第一个工作表复制到合并文件中。 End If bok1.Close 关闭被合并文件 End If f_name = Dir() 获取下一个被合并文件名 LoopEnd Sub6、点击菜单栏运行-运行子过程-用户窗体。关闭代码输入窗口。打开excel工作簿，可以看到下方已经将之前工作簿中的工作表都复制到了这一新建工作簿中。五、多个Excel工作簿的所有工作表（非空白）合并成一个新的工作簿1、将需要合并的excel工作簿文件放置在一个文件夹中。2、在该文件夹中，新建立一个新的excel工作簿文件。3、打开新建立的excel工作簿文件，将鼠标移动到下方工作表名称sheet1上右键，选择查看代码。4、在弹出的代码编辑窗口中，输入代码。5、在代码窗口中，粘贴下列代码：Sub 合并工作薄() Dim Path As String Dim FileName As String Dim LastCell As Range Dim Wkb As Workbook Dim WS As Worksheet Dim ThisWB As String Dim MyDir As String MyDir = ThisWorkbook.Path & ChDriveLeft(MyDir, 1) find all the excel files ChDir MyDir Match =Dir$() ThisWB = ThisWorkbook.Name Application.EnableEvents = False Application.ScreenUpdating = False Path = MyDir FileName = Dir(Path & *.xls, vbNormal) Do Until FileName = If FileName ThisWB Then Set Wkb = Workbooks.Open(FileName:=Path & & FileName) For Each WS In Wkb.Worksheets Set LastCell = WS.Cells.SpecialCells(xlCellTypeLastCell) If LastCell.Value = And LastCell.Address = Range($A$1).Address Then Else WS.Copy After:=ThisWorkbook.Sheets(ThisWork