Macro to copy data from all the files in folder and paste in single sheet

[Subramanian]

Hi,

I am just working with below

i.e I will have a folder that will have say 10 files( all the files will have required data in fixed cell) that i will require data from cell A1, A2, A3 of all the sheet in single file.
and the above files will be overwritten with new file every day or even on same day as an update

Currently i made a 11th file in the folder with a formula (referring each cell by link)to pick the data in single sheet from each data file. But it does not work when user over write formula, same works only when i open and close the overwritten file.

Also tries recording macro but they same gives a very long code and will also not be accurate 10 files was an example folder may contain 70 to 100 files too.

Could some one please suggest a VBA to do all the above task automatically instead using a formula to refer a cell.

Thanks in advance,
Subramanian

[jolivanes]

This should go through all your excel workbooks in the same folder as where the workbook with the code is saved.
It will copy cells A1:A3 from every Sheet and paste it column wise. First in Column A, next in Column B etc etc.
If you have a lot of workbooks, as you indicated, you might have to go for coffee or tea while it is getting the data.

Sub Get_All_Sheets_Values_A1_To_A3()
Dim sPath As String
Dim sFil As String
Dim owb As Workbook
Dim twb As Workbook
Dim sh As Worksheet
Dim j As Long, i As Long
With Application
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With


i = 1
Set twb = ThisWorkbook
sPath = ThisWorkbook.Path & "\"
sFil = Dir(sPath & "*.xl*")
Do While sFil <> "" And sFil <> twb.Name
Set owb = Workbooks.Open(sPath & sFil)


With owb
For j = 1 To owb.Sheets.Count
twb.Sheets("Sheet1").Cells(1, i).Resize(3).Value = owb.Sheets(j).Range("A1:A3").Value
i = i + 1
Next j
End With


owb.Close False 'Close no save
sFil = Dir
Loop
With Application
.Calculation = xlAutomatic
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub