|
发表于 2013-11-17 11:03
|
显示全部楼层
本楼为最佳答案
- Sub merge()
- ActiveSheet.UsedRange.Clear
- Range("a1:b1").Value = Array("工作簿", "工作表")
- Dim strPath As String, strFile As String
- Dim wb As Workbook
- Dim sht As Worksheet
- Dim i As Long
- strPath = ThisWorkbook.Path & Application.PathSeparator
- strFile = Dir(strPath & "*.xls")
- Application.ScreenUpdating = False
- Application.DisplayAlerts = False
- Do While Len(strFile)
- If strFile <> ThisWorkbook.Name Then
- '找到文件后执行的操作
- Set wb = GetObject(strPath & strFile)
- For Each sht In wb.Worksheets
- sht.UsedRange.Copy Cells(Rows.Count, 1).End(xlUp).Offset(1, 2)
- i = sht.UsedRange.Rows.Count
- With Cells(Rows.Count, 1).End(xlUp)(2)
- .Resize(i).Value = wb.Name
- .Offset(, 1).Resize(i).Value = sht.Name
- End With
- Next
- wb.Close False
- End If
- strFile = Dir
- Loop
- Application.ScreenUpdating = True
- Application.DisplayAlerts = True
- MsgBox "整理完成"
- End Sub
复制代码 |
评分
-
查看全部评分
|