Hi,
I'm a total beginner with VBA and have only been able to develop the code attached through research alone and not through my own knowledge.
I'm after some help as I'm stuck for a solution; I want to enter a code in a master workbook that can search for excel workbooks through multiple sub-folders contained within a folder, and then copy a particular cell from every workbook found and paste the value into the master workbook.
The code below works fine (copies and pastes cell D9 from the workbooks found into the master workbook), however it only searches through the sub-folder named ("TA1 BASEMENT"). I want a code that starts searching from the folder "Guardrails & Gratings" onwards.
Can anyone help me with this? Any help would be much appreciated!!
--------------------------------------------------- CODE SO FAR -------------------------------
Sub Copy_Paste()
Dim MyFolder As String
Dim MyFile As String
Dim NewR As Range
MyFolder = "Y:\Syseng\Conventional Systems\Civil Systems\Ladder & Handrails Inspections 2013\Guardrails & Gratings\Schedule 8 Turb Hall\Basement\TA1 BASEMENT"
MyFile = Dir(MyFolder & "\*.xlsx")
Do While MyFile <> ""
' open the source workbook and select the source sheet
Workbooks.Open Filename:=MyFolder & "\" & MyFile
Sheets("0609188").Select
' copy the source range
Sheets("0609188").Range("D9").Select
Selection.Copy
' select current workbook and paste the values starting at B2
Windows("Master File - A.xlsm").Activate
Sheets("Sheet1").Select
Set NewR = ActiveSheet.Range("B" & ActiveSheet.Cells.Rows.Count).End(xlUp).Offset(1, 0)
NewR.PasteSpecial xlPasteValues
ActiveWorkbook.Save
MyFile = Dir
Loop
' This sub will close all workbooks except the workbook in which the code is located.
Dim WkbkName As Object
On Error GoTo Close_Error
Application.ScreenUpdating = False
For Each WkbkName In Application.Workbooks()
If WkbkName.Name <> ThisWorkbook.Name Then WkbkName.Close
Next
' If everything runs all right, exit the sub.
Exit Sub
' Error handler.
Close_Error:
MsgBox Str(Err) & " " & Error()
Resume Next
End Sub
I'm a total beginner with VBA and have only been able to develop the code attached through research alone and not through my own knowledge.
I'm after some help as I'm stuck for a solution; I want to enter a code in a master workbook that can search for excel workbooks through multiple sub-folders contained within a folder, and then copy a particular cell from every workbook found and paste the value into the master workbook.
The code below works fine (copies and pastes cell D9 from the workbooks found into the master workbook), however it only searches through the sub-folder named ("TA1 BASEMENT"). I want a code that starts searching from the folder "Guardrails & Gratings" onwards.
Can anyone help me with this? Any help would be much appreciated!!
--------------------------------------------------- CODE SO FAR -------------------------------
Sub Copy_Paste()
Dim MyFolder As String
Dim MyFile As String
Dim NewR As Range
MyFolder = "Y:\Syseng\Conventional Systems\Civil Systems\Ladder & Handrails Inspections 2013\Guardrails & Gratings\Schedule 8 Turb Hall\Basement\TA1 BASEMENT"
MyFile = Dir(MyFolder & "\*.xlsx")
Do While MyFile <> ""
' open the source workbook and select the source sheet
Workbooks.Open Filename:=MyFolder & "\" & MyFile
Sheets("0609188").Select
' copy the source range
Sheets("0609188").Range("D9").Select
Selection.Copy
' select current workbook and paste the values starting at B2
Windows("Master File - A.xlsm").Activate
Sheets("Sheet1").Select
Set NewR = ActiveSheet.Range("B" & ActiveSheet.Cells.Rows.Count).End(xlUp).Offset(1, 0)
NewR.PasteSpecial xlPasteValues
ActiveWorkbook.Save
MyFile = Dir
Loop
' This sub will close all workbooks except the workbook in which the code is located.
Dim WkbkName As Object
On Error GoTo Close_Error
Application.ScreenUpdating = False
For Each WkbkName In Application.Workbooks()
If WkbkName.Name <> ThisWorkbook.Name Then WkbkName.Close
Next
' If everything runs all right, exit the sub.
Exit Sub
' Error handler.
Close_Error:
MsgBox Str(Err) & " " & Error()
Resume Next
End Sub