Sub 合并选定工作簿的第一个工作表()
'功能:合并某文件下所有Excel工作簿中的第一个工作表
'使用:将要合并的工作簿拷贝到某文件夹下,新建一个工作簿后执行该宏
Dim WBName As String '汇总工作簿名称
Dim WBCurrent As String '当前正在合并的工作簿
Dim i As Integer
Dim FileToOpen As Variant '选定的文件列表
'显示选择文件对话框,使用Ctrl或Shief键选取多个工作簿
FileToOpen = Application _
.GetOpenFilename("Excel Files (*.xls), *.xls", , "请选择要合并的工作簿", , True)
'如果没有选择文件则退出
If IsArray(FileToOpen) = 0 Then
MsgBox "没有选择文件"
Exit Sub
End If
'不显示合并的过程
Application.ScreenUpdating = False
WBName = ActiveWorkbook.Name
'逐个合并工作簿
For i = 1 To UBound(FileToOpen)
'打开一个工作簿
Workbooks.Open Filename:=FileToOpen(i)
WBCurrent = ActiveWorkbook.Name
'将该工作簿复制到汇总工作簿
Sheets("sheet1").Copy Before:=Workbooks(WBName).Sheets(1)
'将去掉".xls"后缀的工作簿文件名作为工作表名称,
ActiveSheet.Name = Left(WBCurrent, Len(WBCurrent) - 4)
'合并后关闭该工作簿
Workbooks(WBCurrent).Close
Next i
Application.ScreenUpdating = True
End Sub
Sub 汇总工作簿()
'功能: 对工作簿中所有工作表选定的区域汇总求和
'使用: 在任一工作表选定需要添加汇总公式的区域后执行该宏
'可以使用 Ctrl和Shief键进行选取,然后执行该宏
Dim RangA As Range '选定区域
Dim c As Range
Dim CellAddress As String '选定区域每个单元格的地址
Set RangA = Selection
'插入一个与现有工作表一样的工作表
Sheets(1).Copy Before:=Sheets(1)
'ActiveSheet.Name = "汇总" 可以根据需要将该工作表命名为”汇总”
For Each c In RangA
'取每个单元格的相对地址
CellAddress = c.Address(RowAbsolute:=False, _
ColumnAbsolute:=False)
'为单元格设置求和公式
Sheets(1).Range(c.Address).Formula = "=sum('" + Sheets(2).Name + ":" _
+ Sheets(Sheets.Count).Name + "'!" + CellAddress + ")"
Next c
End Sub