[已解决]如何在一个文件夹中复制所有.xls的左数第二个sheet（不是sheet2）到新建的.xls中

tongguo84

期待 大家帮助我，因为我有好多表格文件

最佳答案

月排行榜 / 总排行榜

zjdh

2012-3-11 13:37

楼上的宏有点问题
汇总工作表.rar (22.54 KB, 下载次数: 28)

2012-3-11 13:37 上传

点击文件名下载附件

跳转到最佳答案楼层

zjcat35

1. Sub test()
   
2.     Application.ScreenUpdating = False
   
3.     Dim filename As String, path As String, wb As Workbook
   
4.     path = ThisWorkbook.path
   
5.     ChDir (path)
   
6.     filename = Dir(ThisWorkbook.path & "\*.xls")
   
7.     Do While filename <> ""
   
8.         If filename <> [color=Red]"汇总.xls" [/color]Then
   
9.             Set wb = Workbooks.Open(filename:=path & "" & filename)
   
10.             wb.Worksheets(wb.Sheets.Count - 1).Copy after:=ThisWorkbook.Worksheets(ThisWorkbook.Sheets.Count)
    
11.             filename = Dir
    
12.             wb.Close False
    
13.         Else
    
14.             Exit Sub
    
15.         End If
    
16.     Loop
    
17.     Application.ScreenUpdating = True
    
18. End Sub

复制代码

红色部分改成你新建的工作薄名称

zjdh

楼上的宏有点问题
汇总工作表.rar (22.54 KB, 下载次数: 28)

2012-3-11 13:37 上传

点击文件名下载附件

tongguo84

谢谢 好心的朋友们

chnfo

好好学习一下，正好遇到这个问题