VBA Pull Data From Multiple Sheets in Workbooks (if sheet names exist)

[caherrmann]

Hi all,

I am very new to VBA and am stuck trying to edit code I already have written. Essentially, the code I have (below) was intended to loop through multiple files in a folder and pull certain data columns in from a specific worksheet. This worked fine for its original purpose, but was only pulling from one main sheet ("Example A" in the code below). I now need to rewrite the code so that it loops through the files and pulls data from two separate worksheets in each file (Example A and Example B). One thing to note is that not every file has both sheets (some have both, some have one or the other), so I guess I need to incorporate some code to help determine if the sheet even exists and if not, have the code move to the next file? Would appreciate any suggestions, thanks!

Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook
    Dim Rws As Long, Rng As Range
    Set Wb = ThisWorkbook
    MyDir = (file path name is here in my code)
    MyFile = Dir(MyDir & "*.xlsx")
    ChDir MyDir
    Application.ScreenUpdating = 0
    Application.DisplayAlerts = 0
   
    Do While MyFile <> ""
        Workbooks.Open (MyFile)
        Worksheets ("Example A")
            Rws = .Cells(Rows.Count, "A").End(xlUp).Row
            Set Rng = Range(.Cells(9, 1), .Cells(Rws, 9)) 'columns TAMCN to source
            Rng.Copy Wb.Worksheets("1a. Pull Data").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
            ActiveWorkbook.Close True
        End With
        Application.DisplayAlerts = 1
        MyFile = Dir()
    Loop
End Sub

 

[Fluff]

Hi & welcome to MrExcel.
Does the data need to go to the same sheet, or different sheets?

 

[caherrmann]

Hi & welcome to MrExcel.
Does the data need to go to the same sheet, or different sheets?

The data needs to go to the same sheet! I'm trying to pull all the relevant data into a master sheet in a new workbook. And for reference, the data is formatted the same within the two sheets I would be pulling from the files (Example A & Example B), so I would be pulling the same rows/columns from all the relevant worksheets

 

[mumps]

Try:

Sub CopyData()
    Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook, shArr As Variant, i As Long
    Dim Rws As Long, Rng As Range
    shArr = Array("Example A", "Example B")
    Set Wb = ThisWorkbook
    MyDir = "C:\Test\"
    MyFile = Dir(MyDir & "*.xlsx")
    ChDir MyDir
    Application.ScreenUpdating = 0
    Application.DisplayAlerts = 0
    Do While MyFile <> ""
        Workbooks.Open (MyFile)
        For i = LBound(shArr) To UBound(shArr)
            If Evaluate("isref('" & shArr(i) & "'!A1)") Then
                With Sheets(shArr(i))
                    Rws = .Cells(Rows.Count, "A").End(xlUp).Row
                    .Range("A9:A" & Rws).Copy Wb.Sheets("1a. Pull Data").Cells(Wb.Sheets("1a. Pull Data").Rows.Count, "A").End(xlUp).Offset(1, 0)
                End With
            End If
        Next i
        ActiveWorkbook.Close False
        MyFile = Dir()
    Loop
End Sub

Change the folder path (in red) and the sheet names (in blue) to suit your needs. If you need to copy data from more than 2 sheets, simply add the sheet names to the array.

 

[mumps]

I posted the code before getting a chance to read your response in Post #3. Open a new blank workbook and rename a sheet as "Master". Place the macro in the newly created workbook.

 

[caherrmann]

Try:

Sub CopyData()
    Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook, shArr As Variant, i As Long
    Dim Rws As Long, Rng As Range
    shArr = Array("Example A", "Example B")
    Set Wb = ThisWorkbook
    MyDir = "C:\Test\"
    MyFile = Dir(MyDir & "*.xlsx")
    ChDir MyDir
    Application.ScreenUpdating = 0
    Application.DisplayAlerts = 0
    Do While MyFile <> ""
        Workbooks.Open (MyFile)
        For i = LBound(shArr) To UBound(shArr)
            If Evaluate("isref('" & shArr(i) & "'!A1)") Then
                With Sheets(shArr(i))
                    Rws = .Cells(Rows.Count, "A").End(xlUp).Row
                    .Range("A9:A" & Rws).Copy Wb.Sheets("1a. Pull Data").Cells(Wb.Sheets("1a. Pull Data").Rows.Count, "A").End(xlUp).Offset(1, 0)
                End With
            End If
        Next i
        ActiveWorkbook.Close False
        MyFile = Dir()
    Loop
End Sub

Change the folder path (in red) and the sheet names (in blue) to suit your needs. If you need to copy data from more than 2 sheets, simply add the sheet names to the array.

Thank you so much, this worked! You definitely just saved me a few hours of scratching my head.

 

[mumps]

You are very welcome.