|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
Sub 汇总数据()
Application.ScreenUpdating = False
Dim wb As Excel.Workbook
Dim k As Integer
ThisWorkbook.Worksheets(1).Rows("6:60000").ClearContents '清除当前工作表的6-6000行
f = Dir(ThisWorkbook.Path & "\*.xls*") '生成查找EXCEL的目录
Do While f <> "" '在目录中循环
If f <> ThisWorkbook.Name Then '如果不是打开的工作簿
Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & f)
k = wb.Worksheets(1).Columns(2).Cells(wb.Worksheets(1).Columns(2).Cells.Count).End(xlUp).Row
wb.Worksheets(1).Rows("2:" & k).Copy ThisWorkbook.Worksheets(1).Columns(2).Cells(ThisWorkbook.Worksheets(1).Columns(2).Cells.Count).End(xlUp).Offset(1, -1)
wb.Close
End If
f = Dir
Loop
Application.ScreenUpdating = True
End Sub
|
|