[已解决]遍历文件夹下的xls文件，归集同类表格

xdwy

文件夹在e:\学习
该”学习“文件夹下有n个xls文件，希望逐一打开，然后遍历所打开的工作表，如果该工作表的名称第一个字符是英文，则复制该工作表到现有的工作薄类，并同时把该工作表的名字加上该工作薄的名称。
如：有一个工作薄：老师.XLS,里面n表，其中只一的工作表叫”DADF“,因为第一个字符的英文，所以把该工作表复制（或者建立副本）到现在的工作薄，然后在现有的工作薄里面重命名该表的名称为”DADF老师，然后关闭工作薄--老师.xls，然后再打开下一个工作薄，如此循环遍历该“学习” 文件夹下的所有工作薄。请注意，还有一个遍历的遍历工作薄里面的所有表，只要是第一个字符是英文，都如上操作。

另请再执行上述归集宏时，增加一个判断，即如果当前有该文件夹下的xls文件是打开的，就直接关闭，再开始上面的遍历。

感谢老师赐教。

期盼学习中

最佳答案

月排行榜 / 总排行榜

雪日骄阳

2011-6-6 10:38

Sub test()
Dim s1 As String, s2 As String, s3 As String, s4 As String
Dim wk1 As Workbook, wk2 As Workbook
Dim sht1 As Object, sh2 As Object
Dim num1 As Integer, num2 As Integer
Set wk1 = ThisWorkbook
s1 = Dir("e:\学习\*.xls")
Do While s1 <> ""
   Set wk2 = Workbooks.Open("d:\a\" & s1)
   For Each sht2 In wk2.Sheets
       If Left(sht2.Name, 1) Like "[a-zA-Z]" Then
          sht2.Copy After:=wk1.Sheets(wk1.Sheets.Count)
          wk1.ActiveSheet.Name = Split(s1, ".")(0) & sht2.Name
       End If
   Next
   wk2.Close False
   s1 = Dir
Loop
End Sub

跳转到最佳答案楼层

雪日骄阳

Sub test()
Dim s1 As String, s2 As String, s3 As String, s4 As String
Dim wk1 As Workbook, wk2 As Workbook
Dim sht1 As Object, sh2 As Object
Dim num1 As Integer, num2 As Integer
Set wk1 = ThisWorkbook
s1 = Dir("e:\学习\*.xls")
Do While s1 <> ""
   Set wk2 = Workbooks.Open("d:\a\" & s1)
   For Each sht2 In wk2.Sheets
       If Left(sht2.Name, 1) Like "[a-zA-Z]" Then
          sht2.Copy After:=wk1.Sheets(wk1.Sheets.Count)
          wk1.ActiveSheet.Name = Split(s1, ".")(0) & sht2.Name
       End If
   Next
   wk2.Close False
   s1 = Dir
Loop
End Sub

xiuxian

关注学习中

henrywei88

回复 雪日骄阳 的帖子

那能否遍历一个文件夹下所有xls文件（包含子文件夹），然后返加这些文件名到指定单元格（如A列），然后在B列、C列......分别返加A列文件名下的工作表名称？

henrywei88

回复 雪日骄阳 的帖子

那能否遍历一个文件夹下所有xls文件（包含子文件夹），然后返加这些文件名到指定单元格（如A列），然后在B列、C列......分别返加A列文件名下的工作表名称？