Sub GetRangesFromClosedWorkbooks()
'
Dim ColumnOffsetCounter As Long
Dim FileNameRow As Long
Dim ResultsStartColumn As String
Dim SourceDirectory As String
Dim SourceFileAddressColumn As String
Dim SourceFileAddressRow As String
Dim SourceFileName As String
Dim SourceFileNameStartAddress As String
Dim SourceRange1 As String
Dim SourceRange2 As String
Dim SourceRange3 As String
Dim SourceSheet As String
Dim WS As Worksheet
'
Set WS = Sheets("Sheet1") ' <--- Set this to the sheet name used to store values from the closed workbook
ResultsStartColumn = "B" ' <--- Set the Start column to store results in
SourceFileAddressColumn = "A" ' <--- Set this to the column used for Source File Names
SourceFileAddressRow = "5" ' <--- Set this to the start row number used for Source File Names
SourceDirectory = "C:\Test\Data\" ' <--- Set this to the directory of the closed workbooks
SourceRange1 = "B2:B3" ' <--- Set this to the range in the closed workbook to get data from
SourceRange2 = "C5:C10" ' <--- Set this to the range in the closed workbook to get data from
SourceRange3 = "C15:C20" ' <--- Set this to the range in the closed workbook to get data from
'
SourceFileNameStartAddress = SourceFileAddressColumn & SourceFileAddressRow ' Combine Column & Row to form the Start address of the file names
'
LastRowOfFileNames = WS.Range(SourceFileNameStartAddress).End(xlDown).Row ' Find Last used row of file names in column
'
For FileNameRow = SourceFileAddressRow To LastRowOfFileNames ' Range of column to loop through
SourceFileName = SourceFileAddressColumn & FileNameRow ' Set Address to use for the file name of closed workbook
SourceSheet = SourceFileName ' Set the sheet name to use for the closed workbook same as file name
'
ColumnOffsetCounter = 0 ' Initialize the ColumnOffsetCounter
WS.Range(ResultsStartColumn & FileNameRow).Offset(0, ColumnOffsetCounter).Resize(1, Range(SourceRange1).Cells.Count).FormulaArray = _
"=Transpose('" & SourceDirectory & "[" & WS.Range(SourceFileName) & ".xlsx]" & SourceSheet & "'!" & SourceRange1 & ")" ' Set Array Formula for range
'
ColumnOffsetCounter = ColumnOffsetCounter + Range(SourceRange1).Cells.Count ' Calculate start column to display next range of data
WS.Range(ResultsStartColumn & FileNameRow).Offset(0, ColumnOffsetCounter).Resize(1, Range(SourceRange2).Cells.Count).FormulaArray = _
"=Transpose('" & SourceDirectory & "[" & WS.Range(SourceFileName) & ".xlsx]" & SourceSheet & "'!" & SourceRange2 & ")" ' Set Array Formula for range
'
ColumnOffsetCounter = ColumnOffsetCounter + Range(SourceRange2).Cells.Count ' Calculate start column to display next range of data
WS.Range(ResultsStartColumn & FileNameRow).Offset(0, ColumnOffsetCounter).Resize(1, Range(SourceRange3).Cells.Count).FormulaArray = _
"=Transpose('" & SourceDirectory & "[" & WS.Range(SourceFileName) & ".xlsx]" & SourceSheet & "'!" & SourceRange3 & ")" ' Set Array Formula for range
'
Next
'
ColumnOffsetCounter = ColumnOffsetCounter + Range(SourceRange3).Cells.Count - 1 ' Determine last column used for display of data from closed workbook
'
' Set Range to remove formulas from
With WS.Range(ResultsStartColumn & SourceFileAddressRow, WS.Range(ResultsStartColumn & LastRowOfFileNames).Offset(0, ColumnOffsetCounter))
.Value = .Value ' Remove formulas from range, leave just the resulting value found in closed workbook
End With
'
MsgBox "Done" ' Alert user that ranges from closed workbook have been loaded to sheet
End Sub
Code:Sub GetRangesFromClosedWorkbooks() ' Dim ColumnOffsetCounter As Long Dim FileNameRow As Long Dim ResultsStartColumn As String Dim SourceDirectory As String Dim SourceFileAddressColumn As String Dim SourceFileAddressRow As String Dim SourceFileName As String Dim SourceFileNameStartAddress As String Dim SourceRange1 As String Dim SourceRange2 As String Dim SourceRange3 As String Dim SourceSheet As String Dim WS As Worksheet ' Set WS = Sheets("Sheet1") ' <--- Set this to the sheet name used to store values from the closed workbook ResultsStartColumn = "B" ' <--- Set the Start column to store results in SourceFileAddressColumn = "A" ' <--- Set this to the column used for Source File Names SourceFileAddressRow = "5" ' <--- Set this to the start row number used for Source File Names SourceDirectory = "C:\Test\Data\" ' <--- Set this to the directory of the closed workbooks SourceRange1 = "B2:B3" ' <--- Set this to the range in the closed workbook to get data from SourceRange2 = "C5:C10" ' <--- Set this to the range in the closed workbook to get data from SourceRange3 = "C15:C20" ' <--- Set this to the range in the closed workbook to get data from ' SourceFileNameStartAddress = SourceFileAddressColumn & SourceFileAddressRow ' Combine Column & Row to form the Start address of the file names ' LastRowOfFileNames = WS.Range(SourceFileNameStartAddress).End(xlDown).Row ' Find Last used row of file names in column ' For FileNameRow = SourceFileAddressRow To LastRowOfFileNames ' Range of column to loop through SourceFileName = SourceFileAddressColumn & FileNameRow ' Set Address to use for the file name of closed workbook SourceSheet = SourceFileName ' Set the sheet name to use for the closed workbook same as file name ' ColumnOffsetCounter = 0 ' Initialize the ColumnOffsetCounter WS.Range(ResultsStartColumn & FileNameRow).Offset(0, ColumnOffsetCounter).Resize(1, Range(SourceRange1).Cells.Count).FormulaArray = _ "=Transpose('" & SourceDirectory & "[" & WS.Range(SourceFileName) & ".xlsx]" & SourceSheet & "'!" & SourceRange1 & ")" ' Set Array Formula for range ' ColumnOffsetCounter = ColumnOffsetCounter + Range(SourceRange1).Cells.Count ' Calculate start column to display next range of data WS.Range(ResultsStartColumn & FileNameRow).Offset(0, ColumnOffsetCounter).Resize(1, Range(SourceRange2).Cells.Count).FormulaArray = _ "=Transpose('" & SourceDirectory & "[" & WS.Range(SourceFileName) & ".xlsx]" & SourceSheet & "'!" & SourceRange2 & ")" ' Set Array Formula for range ' ColumnOffsetCounter = ColumnOffsetCounter + Range(SourceRange2).Cells.Count ' Calculate start column to display next range of data WS.Range(ResultsStartColumn & FileNameRow).Offset(0, ColumnOffsetCounter).Resize(1, Range(SourceRange3).Cells.Count).FormulaArray = _ "=Transpose('" & SourceDirectory & "[" & WS.Range(SourceFileName) & ".xlsx]" & SourceSheet & "'!" & SourceRange3 & ")" ' Set Array Formula for range ' Next ' ColumnOffsetCounter = ColumnOffsetCounter + Range(SourceRange3).Cells.Count - 1 ' Determine last column used for display of data from closed workbook ' ' Set Range to remove formulas from With WS.Range(ResultsStartColumn & SourceFileAddressRow, WS.Range(ResultsStartColumn & LastRowOfFileNames).Offset(0, ColumnOffsetCounter)) .Value = .Value ' Remove formulas from range, leave just the resulting value found in closed workbook End With ' MsgBox "Done" ' Alert user that ranges from closed workbook have been loaded to sheet End Sub