Excel VBA:批量导出多个文件中某些单元格的内容

上一篇博文“Excel VBA常用语句集锦”罗列了很多VBA脚本，但是比较零碎，还不过瘾。干脆把我这两天写的脚本贴出来好了。首先，说说这个写脚本的用意。以下是某张审计表的截图，QA需要根据“符合项”和“不符合项”来提供项目质量的周报和月报。

亲爱的你有没有注意到：一张审计表中有N个Sheet页，每个Sheet页都有不同的符合项和不符合项。一个项目下来，审计表往往有几十张；要一个个地打开文件，一个个Sheet核对，这是很费力的事情。So，如果能将多个文件中“符合项”“不符合项”的内容批量导出到一张Excel中，是多么Happy的一件事情啊:)

-------------华丽的分割线：VBA脚本--------------------

Sub AutoOpen()
'
' Macro1open Macro
'
'
Dim filelist, b As String
Dim f() As String

MyExcelFileName = Dir("E:\temp\审计表\*.xls") '要修改路径

Do While Len(MyExcelFileName) > 0

        If (Len(filelist) <> 0) Then
    filelist = filelist + "," + MyExcelFileName
        Else
    filelist = filelist + MyExcelFileName
        End If

MyExcelFileName = Dir

Loop

'此处输入文件名列表，用英文逗号分隔
f = Split(filelist, ",")

For Each file In f()
Workbooks.Open Filename:="E:\temp\审计表\" & file '要修改路径

Set Wb = ActiveWorkbook '打开它
'

ThisWorkbook.Sheets(1).Cells(num + 1, 1) = file '第一列放工作簿的名称

For i = 2 To Worksheets.Count
ThisWorkbook.Sheets(1).Cells(num + i, 2) = Worksheets(i).Name '各个sheet的名称

'获得符合项和不符合项数
With Worksheets(i).Range("B6:B100")

Set c = .Find("符合项数", LookIn:=xlValues)
Set d = .Find("不符合项数", LookIn:=xlValues)

ThisWorkbook.Sheets(1).Cells(num + i, 3) = c.Offset(0, 1) 'Offset方法的第一个参数是行偏移，第二个参数是列偏移

ThisWorkbook.Sheets(1).Cells(num + i, 4) = d.End(xlToRight).Text

End With

Next i

       num = num + Wb.Sheets.Count
       On Error Resume Next
                 Wb.Close False ' 不保存就关闭这个打开的工作簿

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

------------------------End----------------------------------

运行之后的效果如图：

Wow, 帅气~VBA真的很强大