Private Sub CommandButton1_Click()
Dim Twb As Workbook, Wb As Workbook
Dim rng As Range, rng2 As Range
Dim s
Dim R As Double, C As Double
Dim T As String
Application.ScreenUpdating = False
Set Twb = ThisWorkbook
For Each s In .FoundFiles '在每一个查找到的结果里
If s <> Twb.FullName Then '假如它不是当前工作簿
Set Wb = Workbooks.Open(s) '打开它
Set rng = Range("a65536").End(xlUp).Offset(1, 0) '设置变量rng为最后一行的下一行
R = Wb.Sheets(1).UsedRange.End(xlDown).Row '当前工作簿已用行数
C = Wb.Sheets(1).UsedRange.End(xlToRight).Column + 1 '当前工作簿已用行数+1
T = "*-FileNme-*" '将字符常量赋给T
Wb.Sheets(1).Cells(1, C).Value = T '将当前工作部最后一列右边第一列第一个单元格赋值T
Wb.Sheets(1).Range(Wb.Sheets(1).Cells(2, C), Wb.Sheets(1).Cells(R, C)).Value = left(Wb.Name,len(wb.name)-4) '为每条信息标注其所在的文件文件名
Wb.Sheets(1).UsedRange.Copy rng '复制新打开的工作簿的第一个工作表的已用区域到rng
Wb.Close False ' 不保存就关闭这个打开的工作簿
End If
Next
End With
Application.ScreenUpdating = True
End Sub
[attach]25098[/attach]