Extracting data from all files in the same folder

[Corleone]

Hi
Im trying to put together some code that will open up all of the other files in the same folder as the one im in
and then select all the data from cell A7 down to wherever the data finishes in column H in all of the files one by one and paste it into my blank spreadsheet from which the macro will be running from.


Im currently getting the following message "File not found" on the following line
SourceFile = Dir(SourcePath & "*.xlsm")

I can confirm that all of the file extensions in the directory are .xlsm

Below is the code

Sub CopyDataFromOtherFiles()
Dim SourcePath As String
Dim SourceFile As String
Dim SourceWorkbook As Workbook
Dim SourceSheet As Worksheet
Dim LastRow As Long
Dim TargetRow As Long
Dim TargetSheet As Worksheet

' Set the source path to the current directory
SourcePath = ThisWorkbook.Path & "C:\Users\shegarty\OneDrive - Network Rail\Profile\Desktop\Latest Analytical Tools - Copy\Period 05 (P04 Contractor Programmes)"

' Set the target worksheet in your current workbook
Set TargetSheet = ThisWorkbook.Sheets(2)

' Initialize the target row to the next available row after existing data
TargetRow = TargetSheet.Cells(TargetSheet.Rows.Count, "A").End(xlUp).Row + 1

' Loop through all files in the source directory
SourceFile = Dir(SourcePath & "*.xlsm")

Do While SourceFile <> ""
If SourceFile <> ThisWorkbook.Name Then ' Exclude the current workbook
' Open the source workbook
Set SourceWorkbook = Workbooks.Open(SourcePath & SourceFile)

' Set the source sheet (tab)
Set SourceSheet = SourceWorkbook.Sheets(2)

' Find the last row with data in columns A to H on the source sheet
LastRow = SourceSheet.Cells(SourceSheet.Rows.Count, "A").End(xlUp).Row

' Copy data from source to target
SourceSheet.Range("A2:H" & LastRow).Copy TargetSheet.Cells(TargetRow, 1)

' Close the source workbook without saving changes
SourceWorkbook.Close False

' Update the target row for the next file
TargetRow = TargetRow + (LastRow - 1)
End If

' Move to the next file
SourceFile = Dir
Loop
End Sub




thanks

 

[Joe4]

You probably need another backslash after your SourcePath, i.e.

SourceFile = Dir(SourcePath & "*.xlsm")

needs to be:

SourceFile = Dir(SourcePath & "\*.xlsm")

 

[Corleone]

Thanks for the response - i have copied this in but unfortunately its still coming up with the same message

 

[Joe4]

I looked a little more closely, and it looks like you have a problem with your SourcePath variable as well. Look closely:

SourcePath = ThisWorkbook.Path & "C:\Users\shegarty\OneDrive - Network Rail\Profile\Desktop\Latest Analytical Tools - Copy\Period 05 (P04 Contractor Programmes)"

You are actually adding TWO paths to this one variable:
- This "Workbook.Path", which captures the FULL path that this Excel file with VBA code resides in
and
-"C:\Users\shegarty\OneDrive - Network Rail\Profile\Desktop\Latest Analytical Tools - Copy\Period 05 (P04 Contractor Programmes)"

You want one or the other, depending on your needs it should NOT be both!

These type of issues are actually pretty easy to debug.
Just before this line here:

SourceFile = Dir(SourcePath & "*.xlsm")

and a line like this:

MsgBox SourcePath & "*.xlsm"

and see what it returns when running it.
It will show you exactly where you are looking for the files, and you will quickly see the problems.

 

[Corleone]

Thank you for looking
I have amended the code as follows but still get the same error message come up on the same line


Sub CopyDataFromOtherFiles()
Dim SourcePath As String
Dim SourceFile As String
Dim SourceWorkbook As Workbook
Dim SourceSheet As Worksheet
Dim LastRow As Long
Dim TargetRow As Long
Dim TargetSheet As Worksheet

' Set the source path to the current directory
SourcePath = ThisWorkbook.Path

' Set the target worksheet in your current workbook
Set TargetSheet = ThisWorkbook.Sheets(2)

' Initialize the target row to the next available row after existing data
TargetRow = TargetSheet.Cells(TargetSheet.Rows.Count, "A").End(xlUp).Row + 1

' Loop through all files in the source directory
SourceFile = Dir(SourcePath & "\*.xlsm")

Do While SourceFile <> ""
If SourceFile <> ThisWorkbook.Name Then ' Exclude the current workbook
' Open the source workbook
Set SourceWorkbook = Workbooks.Open(SourcePath & SourceFile)

' Set the source sheet (tab)
Set SourceSheet = SourceWorkbook.Sheets(2)

' Find the last row with data in columns A to H on the source sheet
LastRow = SourceSheet.Cells(SourceSheet.Rows.Count, "A").End(xlUp).Row

' Copy data from source to target
SourceSheet.Range("A2:H" & LastRow).Copy TargetSheet.Cells(TargetRow, 1)

' Close the source workbook without saving changes
SourceWorkbook.Close False

' Update the target row for the next file
TargetRow = TargetRow + (LastRow - 1)
End If

' Move to the next file
SourceFile = Dir
Loop
End Sub

 

[Joe4]

If you look at the amendments I had made to my last post, what do you get when you add that MsgBox code in?
What does it return?

If you go out to Windows Explorer, and navigate to the path shown in that MsgBox, do you see any "xlsm" files in that folder?

Also, please use Code Tags when posting your code: How to Post Your VBA Code

 

[Corleone]

Apologies - I missed that bit - I have added it in and it returns the following
https://networkrail-my,sharepoint.com/personal/shegarty_networkrail_co_uk/Documents/Profile/Desktop/Latest Analytical Tools - Copy/ Period 05 (P04 Contractor Programmes)*.xlsm

 

[Joe4]

Look at the last folder, it does not have the slash before your file extension.
Because you are using URL instead of the file path (i.e. when you had "C:\..."), I think you need to flip the backslash to a slash, i.e.

SourceFile = Dir(SourcePath & "\*.xlsm")

to this:

SourceFile = Dir(SourcePath & "/*.xlsm")

The whole point of doing the MsgBox is to see what it is returning, and verify it is correct. This showed us what it is looking for.
So it is not enough just to add it, you need to put on your detective cap and analyze what it returns, to make sure it seems reasonable and correct!

 

[Corleone]

Thanks for all your help
I have made the amendment as below but im still getting the same message
Ill keep looking and see whether anything else jumps out

This is what im currently left with at the moment

Sub CopyDataFromOtherFiles()
Dim SourcePath As String
Dim SourceFile As String
Dim SourceWorkbook As Workbook
Dim SourceSheet As Worksheet
Dim LastRow As Long
Dim TargetRow As Long
Dim TargetSheet As Worksheet

' Set the source path to the current directory
SourcePath = ThisWorkbook.Path

' Set the target worksheet in your current workbook
Set TargetSheet = ThisWorkbook.Sheets(2)

' Initialize the target row to the next available row after existing data
TargetRow = TargetSheet.Cells(TargetSheet.Rows.Count, "A").End(xlUp).Row + 1

' Loop through all files in the source directory
MsgBox SourcePath & "*.xlsm"
SourceFile = Dir(SourcePath & "/*.xlsm")

Do While SourceFile <> ""
If SourceFile <> ThisWorkbook.Name Then ' Exclude the current workbook
' Open the source workbook
Set SourceWorkbook = Workbooks.Open(SourcePath & SourceFile)

' Set the source sheet (tab)
Set SourceSheet = SourceWorkbook.Sheets(2)

' Find the last row with data in columns A to H on the source sheet
LastRow = SourceSheet.Cells(SourceSheet.Rows.Count, "A").End(xlUp).Row

' Copy data from source to target
SourceSheet.Range("A2:H" & LastRow).Copy TargetSheet.Cells(TargetRow, 1)

' Close the source workbook without saving changes
SourceWorkbook.Close False

' Update the target row for the next file
TargetRow = TargetRow + (LastRow - 1)
End If

' Move to the next file
SourceFile = Dir
Loop
End Sub

 

[Joe4]

It should be:

MsgBox SourcePath & "/*.xlsm"

(you forgot the slash).

I don't know if it may be a SharePoint thing - I don't use it so have no experience with it.
But are you able to navigate to:
https://networkrail-my,sharepoint.com/personal/shegarty_networkrail_co_uk/Documents/Profile/Desktop/Latest Analytical Tools - Copy/ Period 05 (P04 Contractor Programmes)
on your computer?

If so, do you see any files with "xlsm" extensions in that location (this is part of the detective work you must do - verify there are files matching the criteria you are setting in the location you are looking).

By the way, that URL looks a little funny to me. Is there really a comma in it?