How to copy data from multiple workbook from multiple subfolder

Hi all

I have work book Total.xlsm with sheets(Main, A001, B002, C003, D004,E005,F006)
Total.xlsm is the same path with alot of folders: 202006,202005,202004,202003,......201912,20201911,201910,...etc (Folder have name like yyyymm)

Now I want to have macro to do this:
1. Check each Folder name with range("A2: lastrow)
2. If meet folder.name will check 4 characters of each excel name with: Left(excel_filename,4) = Range("B2:lastrow")
3. If Filename exist will copy data to Total.xlsm like:
Left(excel_filename,4) = "A001" then copy data to workbook("total").sheets("A001").Range("A1")
Left(excel_filename,4) = "B002" then copy data to workbook("total").sheets("B002").Range("A1")
Left(excel_filename,4) = "C003" then copy data to workbook("total").sheets("C003").Range("A1")
Left(excel_filename,4) = "D004" then copy data to workbook("total").sheets("D004").Range("A1")
Left(excel_filename,4) = "E005" then copy data to workbook("total").sheets("E005").Range("A1")
Left(excel_filename,4) = "F006" then copy data to workbook("total").sheets("F006").Range("A1")

Please help me./.

Not tested, but possibly...

Please Login or Register  to view this content.

thanks #dangerlor but code don't work.
Code have twice "lrow" in thisworkbook.sheets("main")

Can you be more specific as to what didn't work?

Partially tested on some fake folders and files.

Please Login or Register  to view this content.

Dear Dan

Your code work but there're have some problem is:

1. For each vFolders have a lot of files wiht name the same 4 first characters, for examble in Folder 202006 have file: A001-123456.xlsx, A001-234567.xlsx etc...
=> So your code copy only one file, not all file begin wiht A001 in filename.

2. Range copy data must be in range as I wrote in my code like:
All file name with A001 must be copy Sheets("A0011").Range("B19:F50")
All file name with B002 must be copy Sheets("B0021").Range("B19:C50")
All file name with C003 must be copy Sheets("C0031").Range("B19:E25")
All file name with D004 must be copy Sheets("D0041").Range("B19:F40")
All file name with E005 must be copy Sheets("E0051").Range("B19:G20")
All file name with F006 must be copy Sheets("F0061").Range("B19:B20")

Sorry for the delay...

Please Login or Register  to view this content.

Thanks Dan, Code work perfect

Thanks for letting me know!