• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Run Macro in all Subfolders

trprasad78

trprasad78

Member
Please help me

I have macro where copy data from excel file in folders and past in master file.

Folders & Subfolders
MD>MarketingHD1>ProjectLead1>excel files.xls*
MD>MarketingHD1>ProjectLead2>excel files.xls*
MD>MarketingHD1>ProjectLead3>excel files.xls*
MD>MarketingHD1>ProjectLead4>excel files.xls*

MD>MarketingHD2>ProjectLead1>excel files.xls*
MD>MarketingHD2>ProjectLead2>excel files.xls*
MD>MarketingHD2>ProjectLead3>excel files.xls*
MD>MarketingHD2>ProjectLead4>excel files.xls*

and so on...
main path := D:\MD\

below macro as to run all in my subfolders and get data and copy to master files.
master file located in D:\MD\

BELOW CODE AS TO RUN IN ALL SUBFOLDERS

Code: 
Sub copyDataFromMultipleWorkbooksIntoMaster()

Dim FolderPath As String, Filepath As String, Filename As String

FolderPath = "D:\MD\"

Filepath = FolderPath & "*.xls*"

Filename = Dir(Filepath)

Dim lastrow As Long, lastcolumn As Long


Do While Filename <> ""

Workbooks.Open (FolderPath & Filename)


lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Range(Cells(3, 1), Cells(lastrow, lastcolumn)).Copy
Application.DisplayAlerts = False
ActiveWorkbook.Close

erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 23))


Filename = Dir

Loop

End Sub
MD>MarketingHD1>ProjectLead1>excel files.xls*
MD>MarketingHD1>ProjectLead2>excel files.xls*
MD>MarketingHD1>ProjectLead3>excel files.xls*
MD>MarketingHD1>ProjectLead4>excel files.xls*
 
I got another code, please check can you help me in this.


I have one more macro where i will get folder and sub folders.

out put sample below in sheet 2

D:\Dec\TEST\LE\Mahesh
D:\Dec\TEST\LE\Rajkumar
D:\Dec\TEST\LE\Shahinsha
D:\Dec\TEST\LE\Mahesh\Babu
D:\Dec\TEST\LE\Rajkumar\Wellington
D:\Dec\TEST\LE\Shahinsha\Irfan
D:\Dec\TEST\LE\Shahinsha\Sudhakar


2nd macro has to check each and above path in sheet2

What i need is following macro as to run each path.

In below macro once grab data from all excel file the FOLDERPATH as to check next row (Sheet2 row no.3)
it has to run sheet2 A Column till end of row.

Please change the below code and past it back. I not good in vb so please do the needful.

Thanks,

Sub copyDataFromMultipleWorkbooksIntoMaster()

Dim FolderPath As String, Filepath As String, Filename As String

FolderPath = "D:\Dec\TEST\LE\Mahesh"

Filepath = FolderPath & "*.xls*"

'To transfer data from all files you can use the wild-card character *


Filepath = FolderPath & "*.xls*"

Filename = Dir(Filepath)

Dim lastrow As Long, lastcolumn As Long


Do While Filename <> ""

Workbooks.Open (FolderPath & Filename)

'Range(“A2:D2”).Copy
lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
lastcolumn = ActiveSheet.Cells(3, Columns.Count).End(xlToLeft).Column
Range(Cells(4, 1), Cells(lastrow, lastcolumn)).Copy
Application.DisplayAlerts = False
ActiveWorkbook.Close

erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

'If we wanted to paste data of more than 4 columns we would define a last column here also
'lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
'ActiveSheet.Paste Destination:=Worksheets(“Sheet1”).Range(Cells(erow, 1),Cells(erow, lastcolumn))

ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 19))


Filename = Dir

Loop

End Sub
 
Hello

Put all paths in A column....and run the loop and assign the same to
FolderPath = variable name. Instead of the below line..
FolderPath = "D:\Dec\TEST\LE\Mahesh"

Sorry am not on my system working through Mobile....so giving you an idea...Hope this helps.

Any chalanges let me know....Happy to Help!!¡!

If you like...don't forget to like.
Monty..
 
Monty said:
Hello

Put all paths in A column....and run the loop and assign the same to
FolderPath = variable name. Instead of the below line..
FolderPath = "D:\Dec\TEST\LE\Mahesh"

Sorry am not on my system working through Mobile....so giving you an idea...Hope this helps.

Any chalanges let me know....Happy to Help!!¡!

If you like...don't forget to like.
Monty..
Click to expand...
Your understanding is right, it has to scan path from file sheet2 from A5 to till end.
It has to loop FILE PATH
I don't know Vba , can you add loop in above code and share it back please.
 
Hi @trprasad78

Put the master file (Example.xlsm in this case) into a different path than "D:\MD\" (where are all the files). The vba code read all the ".xls*" files into this folder and subfolders.

Execute CopytoMasterFile macro (Alt + F8 and run CopytoMasterFile)

Please comment! Blessings!
 

Attachments

  • Example.xlsm
    29.7 KB · Views: 5
Last edited:
John Jairo V said:
Hi @trprasad78

Put the master file (Example.xlsm in this case) into a different path than "D:\MD\" (where are all the files). The vba code read all the ".xls*" files into this folder and subfolders.

Execute CopytoMasterFile macro (Alt + F8 and run CopytoMasterFile)

Please comment! Blessings!
Click to expand...
Thank you so much its working fine. I would like to mention sheet name where data need to pickup.

In all excel file i have sheet name called "Export" , data has to grab from that sheet.

please suggest.

data has to grab only if sheet contain "Export"

Prasad.
 
John Jairo V said:
Hi again!

Add before With wkb.Sheets("Export") This line:
On Error Resume Next

And after of End With
On Error Goto 0

Blessings!
Click to expand...
Thank you so much, sorry to bother you again, It has to past as Value, Because source file data have formulas.

while copy past the formula getting error , to avoid that if we copy and past special as value. that will be good.

also if we get with same format possible ?

Thank you again.

Prasad.
 
Hi again @trprasad78

You must try next time to say all that you want.

Now... change this line:
Code: 
.Range(.Cells(3, 1), .Cells(lr, lc)).Copy ThisWorkbook.ActiveSheet.Range("A" & erow)
For this three lines:
Code: 
.Range(.Cells(3, 1), .Cells(lr, lc)).Copy
ThisWorkbook.ActiveSheet.Range("A" & erow).PasteSpecial xlPasteValues
ThisWorkbook.ActiveSheet.Range("A" & erow).PasteSpecial xlPasteFormats

Blessings!
 
You must log in or register to reply here.
Back
Top