copy-paste data from multiple files ( .xls ) from multiple folders

[CaatalyyN]

Hy all ,
First of all let me apologise if this was already posted and answered . If there is a good known post linked to this issue please post me the link .

My problem :

I'm trying to understand how to modify this code below , so I can acces subfolders from 1 specific directory ( my example : " C:\Desktop\TEST MULTIPLE PATHS\ " - main folder ) , and then , from each subfolder found in my main folder , to add al the data of each .xls file in one main .xls ( this is already figured out and working - for my project .. but for each .xls file in 1 folder :( ) ...
I searched the web and found the function Dir() , but I can't understand how to make it work . ( forgot to tell that I'm using excel 2007 .. and the function/application .filesearch doesen't work ... )

My " import excel " code-macro is the one listed here .. please tell me how to twik it .. to make it work how I want it to work : pray2:


Sub Import_Excel()
'
' Macro3 Macro
' Macro recorded
'
'
Range("C6").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.ClearContents
Range("C6").Select

j = 2
myline = 6
While Sheets("Lista fisiere sucursale").Cells(j, 1) <> NIL
Cells(3, 4) = Sheets("Lista fisiere sucursale").Cells(j, 1)

myname = ActiveWorkbook.Name
MyFile = Dir("C:\Desktop\TEST MULTIPLE PATHS\")
Workbooks.Open Filename:=Cells(1, 15) & Cells(3, 4)
newname = ActiveWorkbook.Name
Windows(myname).Activate
n = 10
n = Sheets("Lista fisiere sucursale").Cells(j, 4)
shname = Sheets("Lista fisiere sucursale").Cells(j, 2)
start_col1 = Sheets("Lista fisiere sucursale").Cells(j, 3)
end_col1 = Sheets("Lista fisiere sucursale").Cells(j, 3) + 2 + Sheets("Lista fisiere sucursale").Cells(j, 5)
start_col2 = Sheets("Lista fisiere sucursale").Cells(j, 6)
end_col2 = Sheets("Lista fisiere sucursale").Cells(j, 6) + Sheets("Lista fisiere sucursale").Cells(j, 5) - 1
While Workbooks(newname).Worksheets(shname).Cells(n, start_col1) <> NIL
ind1 = 3
For ind = start_col1 To end_col1
Cells(myline, ind1) = Workbooks(newname).Worksheets(shname).Cells(n, ind)
ind1 = ind1 + 1
Next ind
ind1 = 12
For ind = start_col2 To end_col2
Cells(myline, ind1) = Workbooks(newname).Worksheets(shname).Cells(n, ind)
ind1 = ind1 + 1
Next ind
myline = myline + 1
n = n + 1
Wend
Windows(newname).Activate
ActiveWindow.Close
j = j + 1
Wend

Range("R5:AC5").Select
Selection.Copy
Range("R5").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Range("R6:AC1347").Select
ActiveSheet.Paste
Range("R5").Select

End Sub

That red bold text is the part where I'm not so good twiking it ... :( ... if anyone can help please be wise with me .. don't mock me for my english .. I know it's not so good ... but I'm trying

I wish you all the best in everyting u do !

cheers :beerchug:

PS : I'm the newest newbie in VBA ... :(

[mdmackillop]

Welcome to VBAX

No time to answer in detail, but here is some generic code to process all files in a folder. The calling file must be in a separate location


Option Explicit

Sub Test()
Dim Pth As String, Fil As String
Dim cel As Range
Pth = "C:\MyPath\"
Fil = Dir(Pth & "*.xls")
Do Until Fil = ""

Set cel = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1)
cel = Fil
cel.Offset(, 1).Resize(, 3) = GetData(Pth & Fil)


Fil = Dir
Loop

End Sub


Private Function GetData(MyFile As String)
Dim WB As Workbook
Set WB = Workbooks.Open(MyFile)
GetData = WB.Sheets(1).Range("A1:C1")
WB.Close False
End Function

[CaatalyyN]

Thank you for your reply , but , sincerly , it doesent really help me with what I want my macro to do - gather each .xls file from every subfolder found in my main folder .

I thoth of something and made it like this : ...

...
myname = ActiveWorkbook.Name
Dim Pth As String
Pth = "C:\Desktop\TEST MULTIPLE PATHS\"
Workbooks.Open Filename:=Pth & Cells(3, 4)
...
( the lithe 3 " ... " are the text from my first post that I think it's irelevant to post it again :) )


.. but it just gets the .xls files from the main folder and doesent look in any subfolders for other .xls files ... :(

I somehow have to make a subfunction ( if that is possible ) or something simillar that extracts all the .xls files from each subfolder found in the main folder , something to get acces to those subfolders ... any other code it doesent really help me ( no offense for your post about how to get data from files and the other ++'es , but it was 'messing' with my own code )

Thank you in advance !

Cheers ! :beerchug:

[mohanvijay]

Try this



Sub Loop_Subfolders()

Dim Oo_FSO As Object
Dim Main_Fol As Object
Dim Sub_Fol As Object
Dim File_Fol As Object

Dim Path_MainFol As String
Dim WK_Path As String

Dim WK_New As Workbook

Path_MainFol = "F:\sss"

Set Oo_FSO = CreateObject("Scripting.FileSystemObject")
Set Main_Fol = Oo_FSO.GetFolder(Path_MainFol)

For Each Sub_Fol In Main_Fol.SubFolders ' loop through each subfolders in main folder
For Each File_Fol In Sub_Fol.Files ' loop through each file in subfolder
If IsExcel_File(File_Fol.Name) Then 'check file is an excel file
WK_Path = File_Fol.Path 'if yes the get full file path

Set WK_New = Workbooks.Open(WK_Path)

'place your code here


End If
Next
Next

Set WK_New = Nothing
Set File_Fol = Nothing
Set Sub_Fol = Nothing
Set Main_Fol = Nothing
Set Ob_Fy = Nothing

End Sub



Function IsExcel_File(File_Name As String) As Boolean

IsExcel_File = False

Dim T_Str As String

T_Str = Trim(File_Name)

If T_Str = "" Or Len(T_Str) < 5 Or InStr(T_Str, ".") = 0 Then Exit Function

T_Str = UCase(Right(T_Str, Len(T_Str) - InStrRev(T_Str, ".")))

If T_Str = "XLS" Or T_Str = "XLSX" Then
IsExcel_File = True
End If

End Function

[CaatalyyN]

Hey ... :(

Thank you mate for your post , I tryed to integrate it in my own code .. but didn't really worked .. I donno .. I may be stupid or something .. or it's my newbie illness in VBA that's overwhelming me ...

See if you can merge your code somehow .. with mine ( in my first post ) , logically I mean ( because u don't have my data in your PC .. doh ! why am I writing this ?? ) ... , if u have some time .. and I donno , maybe that will work .

Now it's Friday 5:00 PM ( here ) .. I'll come back Monday at work - with access to web ... have to go to countryside for the week-end .. and I'll try to post my merging ( capabilities.. that are really lame ... and maybe I'll start some laughting here ) on monday ...

Thanx a billion ! again , for the reply ! :)

Cheers all ! :beerchug: