1.同一目录下的多工作簿，每个工作簿中有一张或多张工作表，一键全部汇总
Sub 合并目录所有工作簿全部工作表()Dim MP, MN, AW, Wbn, wnDim Wb As WorkbookDim i, a, b, d, c, eApplication.ScreenUpdating = FalseMP = ActiveWorkbook.PathMN = Dir(MP & "\" & "*.xls")AW = ActiveWorkbook.NameNum = 0e = 1Do While MN <> ""If MN <> AW ThenSet Wb = Workbooks.Open(MP & "\" & MN)a = a + 1With Workbooks(1).ActiveSheetFor i = 1 To Sheets.CountIf Sheets(i).Range("a1") <> "" ThenWb.Sheets(i).Range("a1").Resize(1, Sheets(i).UsedRange.Columns.Count).Copy .Cells(1, 1)d = Wb.Sheets(i).UsedRange.Columns.Countc = Wb.Sheets(i).UsedRange.Rows.Count - 1wn = Wb.Sheets(i).Name.Cells(1, d + 1) = "表名".Cells(e + 1, d + 1).Resize(c, 1) = MN & wne = e + cWb.Sheets(i).Range("a2").Resize(c, d).Copy .Cells(.Range("a1048576").End(xlUp).Row + 1, 1)End IfNextWbn = Wbn & Chr(13) & Wb.NameWb.Close FalseEnd WithEnd IfMN = DirLoopRange("a1").SelectApplication.ScreenUpdating = TrueMsgBox "共合并了" & a & "个工作薄下全部工作表。如下：" & Chr(13) & Wbn, vbInformation, "提示"End Sub
2.同一工作簿中的多工作表，将指定的多工作表一键汇总
Sub huizongdata()Rows("2:10000").Clear'第一步是先清空汇总表的数据，这里是从第2行开始清理到10000行，可以自己修改。Application.Wait Now + TimeValue("00:00:01") '延迟1秒Dim st As Worksheet, rng As Range, rrow As Integer, i As Integer'定义一些需要用到的变量'For Each st In Worksheets 循环开始，遍历所有的工作表For i = 3 To Worksheets.CountSet st = Sheets(i)Set rng = Range("A10000").End(xlUp).Offset(1, 0)'每次循环就动态定位需要拷贝数据的区域，即获得A列第一个空的单元格rrow = st.Range("A2").CurrentRegion.Rows.Count - 1'获得每个工作表中的数据记录数，即行数，同时需要减去表头的行数，这里是减掉2行。st.Range("A2").Resize(rrow, 9).Copy rng'将数据扩展rows行，4列拷贝到数据，并粘贴到汇总表Next iEnd Sub
