Using VBA to Pull Data From Every Workbook in a Folder

The VBA code below will pull data from every workbook located in a designated folder and put it into a master workbook. The workbooks that have the desired data are called the source workbooks. Each source workbook will be opened one at a time. Data will be copied from the source workbook based on certain conditions and put into the master workbook. After data has been pulled, the source workbook will be closed.

A handful of parameters in this code will need to be changed for your application. The first is the pathway and name of the folder that has the source workbooks. In the code below this pathway and folder name is "C:\Users\sfost\Desktop\New folder\". The second is the name of the worksheet in each source workbook. The name needs to be the same and is "Sheet1" in the code below. The third is the range of the data that will be copied from each source workbook. In the code below the range is "Ax:Ex". Finally, the conditions that determine what data in the source workbook that will be pulled. Again, all of these parameters will need to be adjusted for your application. Additional code can be added if sheet names or ranges change for each source workbook.

Microsoft Excel - Andon Excel - Pulling data from multiple workbooks into a single workbook.

Sub DataPull_1()

Application.ScreenUpdating = False

Application.EnableEvents = False

Dim TWB As Workbook

Dim SH2 As Worksheet

Dim SCR As Workbook

Set TWB = ThisWorkbook

Set SH2 = TWB.Worksheets("Sheet2")

Dim Source As String

Dim StrFile As String

Dim LR_SH2 As Long

Dim LR_SCR As Long

Dim n As Long

' Clearing contents currently in the data pull workbook.

LR_SH2 = SH2.Cells(Rows.Count, "A").End(xlUp).Row

If LR_SH2 > 1 Then

SH2.Range("A2:E" & LR_SH2).ClearContents

End If

' Settnig the folder pathway.

Source = "C:\Users\sfost\Desktop\New folder\"

StrFile = Dir(Source)

n = 2

' Pull data from every file.

Do While Len(StrFile) > 0

' Assuming the data pull workbook is in the same file as the workbooks data will be pulled from.

If StrFile = TWB.Name Then

GoTo NextFile

End If

' Opening workbook.

Set SCR = Workbooks.Open(Filename:=Source & StrFile, ReadOnly:=True)

LR_SCR = SCR.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row

' Copying data from workbook if conditions are met.

For A = 2 To LR_SCR

If SCR.Worksheets("Sheet1").Cells(A, "C").Value = "High" Then

SH2.Range("A" & n & ":E" & n) = SCR.Worksheets("Sheet1").Range("A" & A & ":E" & A).Value

n = n + 1

End If

Next A

SCR.Close SaveChanges:=False

NextFile:

StrFile = Dir()

Loop

Application.ScreenUpdating = True

Application.EnableEvents = True

End Sub