Gathering Data From Multiple Files in Same Folder in Particular Range

[shah0101]

Hi Expert,

Is there a way to extract data from hundreds of files in single folder from particular range? I googled and found various options but none of them seems to be working with me.

Basically all files in one folder and range is B53:O153.

I would prefer the power query but query is bringing up only top rows and I can not figure out where to put in range, I am using Excel 2021, can anyone help to guide me please..

Also tried below code but it goes on and on and then I have to forcibly close Excel to stop.

Sub CopyValuesFromFiles()
Dim sourceFolder As String
Dim sourceFiles As Object
Dim sourceFile As Object
Dim wbSource As Workbook
Dim wsDestination As Worksheet
Dim destinationRow As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False

' Set the path to the source folder modify accordingly
sourceFolder = "Z:\DOCUMENTS\INVOICES- 24-25"

' Set the destination worksheet modify sheet name accordingly
Set wsDestination = ThisWorkbook.Worksheets("Customers")

' Initialize the destination row
destinationRow = 2

' Create a FileSystemObject to work with files in the folder
Set sourceFiles = CreateObject("Scripting.FileSystemObject").GetFolder(sourceFolder).Files

' Loop through each file in the folder
For Each sourceFile In sourceFiles
' Check if the file is an Excel file
If sourceFile.Name Like "*.xlsm*" Then
' Open the source workbook
Set wbSource = Workbooks.Open(sourceFile.Path)

' Copy the values from B53 to O153
wbSource.Worksheets(1).Range("B53:O153").Copy

' Paste the values to the destination worksheet
wsDestination.Range("A" & destinationRow).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

' Update the destination row for the next set of values
destinationRow = destinationRow + 1

' Close the source workbook without saving changes
wbSource.Close SaveChanges:=False
End If
Next sourceFile

' Clear the clipboard
Application.CutCopyMode = False

' Display a message when the copying is complete
MsgBox "Copying customer information from files complete."

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub




Thanks in advance.

 

[alex78]

Hi @shah0101,

Can the following code be an option to grab your specific data range through Power Query?

= Table.FromColumns(List.Transform(Table.ToColumns(Your sheet data), (x)=> List.Range(x, 53,103)))

Regards,

 

[shah0101]

Hi @shah0101,

Can the following code be an option to grab your specific data range through Power Query?

= Table.FromColumns(List.Transform(Table.ToColumns(Your sheet data), (x)=> List.Range(x, 53,103)))

Regards,

Dear @alex78 ,

Thanks for getting involved.

I am open to all options as long as the option gets ne the required data quickly without disturbing other colleagues who are also working on these files on the same folder.

I have tried query before, I was not able to figure out where to put in the range please advise should I transform , combine or combine and load? Not a very tech savvy guy, Thanks for your help please.

 

[shah0101]

Dear @alex78 ,

Thanks for getting involved.

I am open to all options as long as the option gets ne the required data quickly without disturbing other colleagues who are also working on these files on the same folder.

I have tried query before, I was not able to figure out where to put in the range please advise should I transform , combine or combine and load? Not a very tech savvy guy, Thanks for your help please.

View attachment 115608

Hi @alex78

Just tried to put it where I thought it has to go as per my tech capacity and recieve following:

 

[kvsrinivasamurthy]

Pl upload the file in some website and give link here.

 

[alex78]

Dear @alex78 ,

Thanks for getting involved.

I am open to all options as long as the option gets ne the required data quickly without disturbing other colleagues who are also working on these files on the same folder.

I have tried query before, I was not able to figure out where to put in the range please advise should I transform , combine or combine and load? Not a very tech savvy guy, Thanks for your help please.

View attachment 115608

Hello @shah0101,

it's difficult to help you without knowing the "Customers" sheets structure. Range "B53:O153" with headers ? Cell "A1" filled ?...

An attempt:

let
    // Data: to be updated: Folder location,Sheet Name, rows, columns
    Data = {"Z:\DOCUMENTS\INVOICES- 24-25", "Customers", {53..153}, List.Count({"B".."O"})},
    List_Tables = List.RemoveNulls(List.Transform(Table.SelectRows(Folder.Files(Data{0}),
                  each not Text.StartsWith([Name], "~"))[Content],
                  (x)=> try (Table.SelectRows(Excel.Workbook(x), each [Name] = Data{1})[Data]{0}) otherwise null)),
    Result = Table.Combine(List.Transform(List_Tables, each let x = List.Transform(Table.ToColumns(_), each List.Range(_,Data{2}{0}-1,List.Count(Data{2})))
             in Table.FromColumns(List.Transform({1..Data{3}}, each x{_}))))
in
    Result

Regards,

 

[NdNoviceHlp]

Shah101. Your worksheet name must have an additional blank space in " Customers" or "Customers ". Rename the sheet. Here's some code that will be quickest. It loads all of your data from all of your wb's in arrays first and then enters all the data to your operational wb at once. Still not clear where you want "B1" & "B15"? This code puts them in "O" in the first 2 rows offset the main range that is transferrred. Dave

Sub CopyValuesFromFiles()
Dim sourceFolder As String
Dim sourceFiles As Object
Dim sourceFile As Object
Dim WbSource As Workbook
Dim wsDestination As Worksheet, ArrB() As Variant, ArrB2() As Variant
Dim Rng As Range, LastRow As Integer, Arr() As Variant, ArCnt As Integer, Cnt As Integer

On Error GoTo ErFix
Application.ScreenUpdating = False
Application.DisplayAlerts = False

' Set the destination worksheet modify sheet name accordingly
Set wsDestination = ThisWorkbook.Worksheets("Customers")

' Set the path to the source folder modify accordingly
sourceFolder = "Z:\DOCUMENTS\INVOICES- 24-25\"
' Create a FileSystemObject to work with files in the folder
Set sourceFiles = CreateObject("Scripting.FileSystemObject").GetFolder(sourceFolder).Files

' Loop through each file in the folder
For Each sourceFile In sourceFiles
' Check if the file is an Excel file
If sourceFile.Name Like "*.xlsm*" Then
'load ranges to arrays
ArCnt = ArCnt + 1
ReDim Preserve Arr(ArCnt)
ReDim Preserve ArrB(ArCnt)
ReDim Preserve ArrB2(ArCnt)

' Open the source workbook
Set WbSource = Workbooks.Open(sourceFile.Path)
' Copy the values from B53 to O153
Set Rng = WbSource.Worksheets(1).Range("B53:O153")
Arr(ArCnt - 1) = Rng
ArrB(ArCnt - 1) = WbSource.Worksheets(1).Range("B1")
ArrB2(ArCnt - 1) = WbSource.Worksheets(1).Range("B15")
' Close the source workbook without saving changes
WbSource.Close savechanges:=False
End If
Next sourceFile

'Place the values to the destination worksheet
For Cnt = LBound(Arr) To UBound(Arr) - 1
With wsDestination
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
End With
wsDestination.Range("A" & LastRow + 1).Resize(UBound(Arr(Cnt)), 14).Cells.Value = Arr(Cnt)
wsDestination.Range("O" & LastRow + 1).Value = ArrB(Cnt)
wsDestination.Range("O" & LastRow + 2).Value = ArrB2(Cnt)
Next Cnt

ErFix:
If Err.Number <> 0 Then
MsgBox "Error"
Else
' Display a message when the copying is complete
MsgBox "Copying customer information from files complete."
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Set sourceFiles = Nothing
End Sub

 

[shah0101]

Shah101. Your worksheet name must have an additional blank space in " Customers" or "Customers ". Rename the sheet. Here's some code that will be quickest. It loads all of your data from all of your wb's in arrays first and then enters all the data to your operational wb at once. Still not clear where you want "B1" & "B15"? This code puts them in "O" in the first 2 rows offset the main range that is transferrred. Dave

Sub CopyValuesFromFiles()
Dim sourceFolder As String
Dim sourceFiles As Object
Dim sourceFile As Object
Dim WbSource As Workbook
Dim wsDestination As Worksheet, ArrB() As Variant, ArrB2() As Variant
Dim Rng As Range, LastRow As Integer, Arr() As Variant, ArCnt As Integer, Cnt As Integer

On Error GoTo ErFix
Application.ScreenUpdating = False
Application.DisplayAlerts = False

' Set the destination worksheet modify sheet name accordingly
Set wsDestination = ThisWorkbook.Worksheets("Customers")

' Set the path to the source folder modify accordingly
sourceFolder = "Z:\DOCUMENTS\INVOICES- 24-25\"
' Create a FileSystemObject to work with files in the folder
Set sourceFiles = CreateObject("Scripting.FileSystemObject").GetFolder(sourceFolder).Files

' Loop through each file in the folder
For Each sourceFile In sourceFiles
' Check if the file is an Excel file
If sourceFile.Name Like "*.xlsm*" Then
'load ranges to arrays
ArCnt = ArCnt + 1
ReDim Preserve Arr(ArCnt)
ReDim Preserve ArrB(ArCnt)
ReDim Preserve ArrB2(ArCnt)

' Open the source workbook
Set WbSource = Workbooks.Open(sourceFile.Path)
' Copy the values from B53 to O153
Set Rng = WbSource.Worksheets(1).Range("B53:O153")
Arr(ArCnt - 1) = Rng
ArrB(ArCnt - 1) = WbSource.Worksheets(1).Range("B1")
ArrB2(ArCnt - 1) = WbSource.Worksheets(1).Range("B15")
' Close the source workbook without saving changes
WbSource.Close savechanges:=False
End If
Next sourceFile

'Place the values to the destination worksheet
For Cnt = LBound(Arr) To UBound(Arr) - 1
With wsDestination
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
End With
wsDestination.Range("A" & LastRow + 1).Resize(UBound(Arr(Cnt)), 14).Cells.Value = Arr(Cnt)
wsDestination.Range("O" & LastRow + 1).Value = ArrB(Cnt)
wsDestination.Range("O" & LastRow + 2).Value = ArrB2(Cnt)
Next Cnt

ErFix:
If Err.Number <> 0 Then
MsgBox "Error"
Else
' Display a message when the copying is complete
MsgBox "Copying customer information from files complete."
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Set sourceFiles = Nothing
End Sub

Thank @NdNoviceHlp

For some reasons I am not getting through this worksheet line.

Have uploaded the file for you experts to look into please:

Loading Google Sheets

 

[shah0101]

Hello @shah0101,

it's difficult to help you without knowing the "Customers" sheets structure. Range "B53:O153" with headers ? Cell "A1" filled ?...

An attempt:

let
    // Data: to be updated: Folder location,Sheet Name, rows, columns
    Data = {"Z:\DOCUMENTS\INVOICES- 24-25", "Customers", {53..153}, List.Count({"B".."O"})},
    List_Tables = List.RemoveNulls(List.Transform(Table.SelectRows(Folder.Files(Data{0}),
                  each not Text.StartsWith([Name], "~"))[Content],
                  (x)=> try (Table.SelectRows(Excel.Workbook(x), each [Name] = Data{1})[Data]{0}) otherwise null)),
    Result = Table.Combine(List.Transform(List_Tables, each let x = List.Transform(Table.ToColumns(_), each List.Range(_,Data{2}{0}-1,List.Count(Data{2})))
             in Table.FromColumns(List.Transform({1..Data{3}}, each x{_}))))
in
    Result

Regards,

Dear @alex78

The worksheet "Customers" is the destination sheet where the data has to be loaded. The source files are in one folder with different file names. B53:O153 with NOT with headers. The B53:O153 range + Cell B1 + Cell B15 are in those files from where I need to dig the data and bring into any new file, the name "Customers" is not necessary.

If you have noticed I have uploaded the file which is obviously empty but with code.

Thanks again!

 

[kvsrinivasamurthy]

Code is working ok in Excel. I do not know about google sheets.

 

[shah0101]

Did you tested it on Excel 2021?

Code is working ok in Excel. I do not know about google sheet