[已解决]同一个工作簿下多个相同格式工作表的数据汇总到新工作表问题

炒牛河

在同一个工作簿下有多个相同格式的工作表（工作表数量不是固定的），需要把每个工作表中A4：L21这部分区域的数据汇总到新建的工作表里，新建的汇总工作表在同一个工作簿下，并命名为“汇总表”，还有，在“汇总表”最后新建一列，把前面每个工作表里E2单元格的数据复制到新建的列里。请教论坛各路高手！

最佳答案

月排行榜 / 总排行榜

327718098

2017-5-11 13:56

Sub text()
Dim  w As Worksheet,hh as long
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & "汇总表.xlsm"
Workbooks("汇总表.xlsm").Sheets("sheet1").Name = "汇总表"
For Each w In Workbooks("abc.xls").Worksheets
hh = Workbooks("汇总表.xlsm").Sheets("汇总表").Cells(Rows.Count, "k").End(3).Row + 1
w.Range("a4:l21").Copy Workbooks("汇总表.xlsm").Worksheets("汇总表").Cells(hh, 1)
Workbooks("汇总表.xlsm").Worksheets("汇总表").Cells(hh, "m") = w.Cells(2, "e")
Next
End Sub

跳转到最佳答案楼层

sanfuhai

给你一段代码，汇总工作表然后在同一个工作簿内统计吧，这段代码你必须将需统计的工作表放到固定的顺序
Sub Books2Sheets()
     '定义对话框变量
     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(4).Copy Before:=newwb.Worksheets(i) '此处的Worksheets(4)，数量4表示是工作表的数量，以从左往右数
               
                 '把新工作簿的工作表名字改成被复制工作簿文件名，这儿应用于xls文件，即Excel97-2003的文件，如果是Excel2007，需要改成xlsx；如果数据源文件类型是其他，那就写为其他。比如 是csv格式的，可以写成 ".xls", 改成".csv"
                 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
End Sub

炒牛河

sanfuhai 发表于 2017-5-11 13:43
给你一段代码，汇总工作表然后在同一个工作簿内统计吧，这段代码你必须将需统计的工作表放到固定的顺序
Su ...

首先感谢老师的回复，有点疑问，这必须是首先知道被汇总的工作簿有几个工作表，如果包含很多工作表，能否把代码改成任意个工作表都适用呢？

327718098

Sub text()
Dim  w As Worksheet,hh as long
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & "汇总表.xlsm"
Workbooks("汇总表.xlsm").Sheets("sheet1").Name = "汇总表"
For Each w In Workbooks("abc.xls").Worksheets
hh = Workbooks("汇总表.xlsm").Sheets("汇总表").Cells(Rows.Count, "k").End(3).Row + 1
w.Range("a4:l21").Copy Workbooks("汇总表.xlsm").Worksheets("汇总表").Cells(hh, 1)
Workbooks("汇总表.xlsm").Worksheets("汇总表").Cells(hh, "m") = w.Cells(2, "e")
Next
End Sub

炒牛河

327718098 发表于 2017-5-11 13:56
Sub text()
Dim s As String, w As Worksheet
s = ThisWorkbook.Path & "\" & "汇总表.xlsm"

说：hh未定义变量

327718098

炒牛河 发表于 2017-5-11 14:30
说：hh未定义变量

Dim s As String, w As Worksheet,hh as long

炒牛河

327718098 发表于 2017-5-11 14:38
Dim s As String, w As Worksheet,hh as long

调试时候建立新文件，但提示文件类型错误。截图了。

327718098

炒牛河 发表于 2017-5-12 10:19
调试时候建立新文件，但提示文件类型错误。截图了。

你看看你新建的扩展名是什么啊，你原本那个是xls，我vba创建的工作簿用的是xlsm，你新建的工作簿把扩展名改成相同的就可以了

炒牛河

327718098 发表于 2017-5-12 10:47
你看看你新建的扩展名是什么啊，你原本那个是xls，我vba创建的工作簿用的是xlsm，你新建的工作簿把扩展名 ...

你意思是新建立的需要改名成汇总表那个文件类型改成xlsm？这不是VBA自己设定吗？我也试过把原来的ABC文件类型改成xlsm，也不行。
调试时候"ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & "汇总表.xlsm""这句出问题了

327718098

炒牛河 发表于 2017-5-12 12:45
你意思是新建立的需要改名成汇总表那个文件类型改成xlsm？这不是VBA自己设定吗？我也试过把原来的ABC文件 ...

workbooks("新建工作簿的名称和扩展名")SaveAs Filename:=ThisWorkbook.Path & "\" & "汇总表.xlsm"这句是更改新建工作簿的名称和扩展名，括号里填新建工作簿的名称和扩展名，不知道叫什么名字的话鼠标定在宏内，按F8单步执行，执行到这一句时你你看看新建工作簿是什么名称，新建的工作簿都是打开的
很多电脑用active老是会错，真心不明白，在不行，你传附件吧