將記錄從文件夾中的多個工作簿復制到摘要工作簿

Question

文件夾中有多個這種格式的工作簿。 我需要摘要工作簿中不是'@gmail.com'的記錄。

Answer 1

這應該為您解決問題。 您可能需要添加腳本運行時引用才能使用FileSystemObject。

Sub GetMail()

Dim MySht As Worksheet
Dim SrcWbk As Workbook
Dim SrcSht As Worksheet
Dim FSO As New FileSystemObject
Dim Fl As File

Set MySht = ThisWorkbook.Sheets(1)
MySht.Range("A1").Value = "Procedure"
MySht.Range("B1").Value = "Email"

'Loop through all of the files in the folder
For Each Fl In FSO.GetFolder("").Files
    'Open the file
    Set SrcWbk = Workbooks.Open(Fl.Path)
    Set SrcSht = SrcWbk.Sheets(1)
    'Loop down all of the rows
    For x = 2 To SrcSht.Range("A2").End(xlDown).Row
        'Check if it's a @Gmail.com address
        If InStr(1, UCase(SrcSht.Cells(x, 2).Value), "@GMAIL.COM") = 0 Then
            If MySht.Range("A2").Value = "" Then
                MySht.Range("A2").Value = SrcSht.Cells(x, 1).Value
                MySht.Range("A2").Offset(0, 1).Value = SrcSht.Cells(x, 2).Value
            Else
                MySht.Range("A1").End(xlDown).Offset(1, 0).Value = SrcSht.Cells(x, 1).Value
                MySht.Range("A1").End(xlDown).Offset(1, 1).Value = SrcSht.Cells(x, 2).Value
            End If
        End If
    Next
    Set SrcSht = Nothing
    SrcWbk.Close False
    Set SrcWbk = Nothing
Next

End Sub