Loop through each excel file in a folder

[quetzal]

Hi,
I have a folder full of excel files and I would need to copy all values from the cell B32 from each sheet and paste them into one column in the master file. It is OK if the cell B32 is empty.
Could anyone help with that?
Thank you so much!

[jolivanes]

The Workbook with this code in it needs to be saved in the same folder where all the other workbooks are in.
Change references where required.

Sub Copy_From_All_Sheets_In_All_Workbooks()
Dim wb As String, i As Long
Dim t
Application.ScreenUpdating = False
t = Timer
wb = Dir(ThisWorkbook.Path & "\*")
Do Until wb = ""
If wb <> ThisWorkbook.Name Then
Workbooks.Open ThisWorkbook.Path & "\" & wb
For i = 1 To Workbooks(wb).Sheets.Count
ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1).Value = Workbooks(wb).Sheets(i).Range("B32").Value
Next i
Workbooks(wb).Close False
End If
wb = Dir
Loop
Application.ScreenUpdating = True
MsgBox "This macro took " & Format(Round(Timer - t, 2), "00:00:00.00") & " seconds to copy" & vbLf & _
"data from all sheets in all closed workbooks."
End Sub

[quetzal]

Thank you so much! I had to change it slightly in case i would need to copy more values from the column B and It doesn't wanna work:


Sub Copy_From_All_Sheets_In_All_Workbooks()
Dim wb As String, i As Long
Dim t
Application.ScreenUpdating = False
t = Timer
wb = Dir("C:\Users\hoju1004\Desktop\jh\Rubber\2016\*.xlsx")
Do Until wb = ""
If wb <> ThisWorkbook.Name Then
Workbooks.Open ThisWorkbook.Path & "\" & wb
For i = 2 To Workbooks(wb).Sheets.Count


If IsEmpty(Workbooks(wb).Sheets(i).Range("B42").Value) = True Then
GoTo Here1
Else
If IsEmpty(Workbooks(wb).Sheets(i).Range("B43").Value) = True Then

Workbooks(wb).Sheets(i).Range("B42").Select
Selection.Copy
ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Else
Workbooks(wb).Sheets(i).Range("B42").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If

End If

Here1:
Next i
Workbooks(wb).Close False
End If
wb = Dir
Loop
Application.ScreenUpdating = True
MsgBox "This macro took " & Format(Round(Timer - t, 2), "00:00:00.00") & " seconds to copy" & vbLf & _
"data from all sheets in all closed workbooks."
End Sub

[jolivanes]

Just explain what you need. Now people have to wade through code that, as you said, does not work.

[quetzal]

17040

Here is one sample of the files from which I would need to collect all the data listed in the table for extrusion line L-1604 from each day Monday-Friday. I need to know what was extruded in the whole year on this line.

Thank you so much!

[jolivanes]

Worksheets are protected in attachment

[quetzal]

I know, they are partially, but if I copy It manually and paste only the values it works.

[jolivanes]

If workbooks and/or sheets are protected, the people that are trying to help you cannot makes changes for testing. Not all that difficult to grasp I would say.


Sub Copy_From_All_Sheets_In_All_Workbooks()
Dim wb As String, i As Long, a As Long
Dim t
Application.ScreenUpdating = False
t = Timer
wb = Dir(ThisWorkbook.Path & "\*")
Do Until wb = ""
If wb <> ThisWorkbook.Name Then
Workbooks.Open ThisWorkbook.Path & "\" & wb
For i = 2 To Workbooks(wb).Sheets.Count
If Not IsEmpty(Workbooks(wb).Sheets(i).Range("B42")) Then
a = Workbooks(wb).Sheets(i).Range("B42", Workbooks(wb).Sheets(i).Range("B75").End(xlUp)).Rows.Count
ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(a).Value = _
Workbooks(wb).Sheets(i).Range("B42").Resize(a).Value
End If
Next i
Workbooks(wb).Close False
End If
wb = Dir
Loop
Application.ScreenUpdating = True
MsgBox "This macro took " & Format(Round(Timer - t, 2), "00:00:00.00") & " seconds to copy" & vbLf & _
"data from all sheets in all closed workbooks."
End Sub

[quetzal]

Thank you very very much :)