Snasui Excel Forum

Code: Select all

Option Explicit
Sub CollectData()
    Dim sh As Worksheet, thisBook As Workbook, strThisbook As Variant
    Dim ob As Workbook, i As Integer, rRow As Long, tg As Range
    
    Set ob = ThisWorkbook
    ob.Sheets(1).UsedRange.Clear
    strThisbook = Application.GetOpenFilename(Filefilter:= _
            "All File (*.*), *.*", Title:="Please select source file(s).", MultiSelect:=True)
    If TypeName(strThisbook) = "Boolean" Then
        MsgBox "Please select file(s)."
        Exit Sub
    End If
    rRow = 1
    For i = 1 To UBound(strThisbook)
        Set thisBook = Workbooks.Open(strThisbook(i))
        Application.ScreenUpdating = False
        For Each sh In thisBook.Worksheets
            sh.UsedRange.Copy
            ob.Sheets(1).Range("a" & rRow).PasteSpecial xlPasteValues
            rRow = ob.Sheets(1).UsedRange.Rows.Count + 1
            Application.CutCopyMode = False
        Next sh
        thisBook.Saved = True
        thisBook.Close
    Next i
    Application.ScreenUpdating = True
    MsgBox "Data already collected."
End Sub