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

caherrmann

New Member
Joined
Oct 15, 2020
Messages
3
Office Version
  1. 365
Platform
  1. Windows
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!

VBA Code:
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
 
Last edited by a moderator:

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.
Hi & welcome to MrExcel.
Does the data need to go to the same sheet, or different sheets?
 
Upvote 0
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
 
Upvote 0
Try:
Rich (BB code):
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.
 
Upvote 0
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.
 
Upvote 0
Try:
Rich (BB code):
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.
 
Upvote 0

Forum statistics

Threads
1,213,489
Messages
6,113,952
Members
448,535
Latest member
alrossman

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top