Hello
I have a programme that updates a master workbook (performq2y.xlsx) with data from worksheets contained in 24 workbooks in a specific source folder ("c:\data\persist2y\persistance_2y120"). The problem now is that I have 120 folders (again each with 24 workbooks) in the source folder (last three digits of source folder run from1 to 120). I want to update the master workbook with data from 2,880 (24 x 120) worksheets from all the worksheets contained in the 120 folders. I could run my existing VBA programme 120 times, but that seems very silly. Is there a way to adapt my VBA programme to do this all in one step? I attach my existing programme.
Private Sub CommandButton1_Click()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range
Dim rng4 As Range
Dim rng5 As Range
Dim rng6 As Range
Dim rng7 As Range
Dim rng8 As Range
Dim rng9 As Range
Dim rng10 As Range
Dim rng11 As Range
Dim rng12 As Range
Dim rng13 As Range
Dim rng14 As Range
Dim Master As Workbook
Dim sourceBook As Workbook
Dim sourceData As Worksheet
Dim CurrentFileName As String
Dim myPath As String
Dim lrow As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set Master = wb1
Set wb1 = Workbooks.Open(Filename:="c:\data\persistresults\performq2y.xlsx")
Set ws1 = wb1.Worksheets("BystrategySRd")
myPath = "c:\data\persist2y\persistance_2y120"
CurrentFileName = Dir(myPath & "\*.xls")
Do
Workbooks.Open (myPath & "\" & CurrentFileName)
Set sourceBook = Workbooks(CurrentFileName)
Set sourceData = sourceBook.Worksheets(9)
Set rng1 = ws1.Range("b65536").End(xlUp).Offset(1, 0)
Set rng2 = ws1.Range("c65536").End(xlUp).Offset(1, 0)
Set rng3 = ws1.Range("d65536").End(xlUp).Offset(1, 0)
Set rng4 = ws1.Range("e65536").End(xlUp).Offset(1, 0)
Set rng5 = ws1.Range("f65536").End(xlUp).Offset(1, 0)
Set rng6 = ws1.Range("g65536").End(xlUp).Offset(1, 0)
Set rng7 = ws1.Range("h65536").End(xlUp).Offset(1, 0)
Set rng8 = ws1.Range("i65536").End(xlUp).Offset(1, 0)
Set rng9 = ws1.Range("j65536").End(xlUp).Offset(1, 0)
Set rng10 = ws1.Range("k65536").End(xlUp).Offset(1, 0)
Set rng11 = ws1.Range("l65536").End(xlUp).Offset(1, 0)
Set rng12 = ws1.Range("m65536").End(xlUp).Offset(1, 0)
Set rng13 = ws1.Range("n65536").End(xlUp).Offset(1, 0)
Set rng14 = ws1.Range("o65536").End(xlUp).Offset(1, 0)
With sourceData
rng1 = sourceData.Range("b4")
rng2 = sourceData.Range("b5")
rng3 = sourceData.Range("b6")
rng4 = sourceData.Range("b7")
rng5 = sourceData.Range("b8")
rng6 = sourceData.Range("b9")
rng7 = sourceData.Range("b10")
rng8 = sourceData.Range("b11")
rng9 = sourceData.Range("b12")
rng10 = sourceData.Range("b13")
rng11 = sourceData.Range("b14")
rng12 = sourceData.Range("b15")
rng13 = sourceData.Range("b16")
rng14 = sourceData.Range("b17")
End With
sourceBook.Close
'Calling DIR w/o argument finds the next .xlsx file within the current directory.
CurrentFileName = Dir()
Loop While CurrentFileName <> ""
wb1.Save
wb1.Close
MsgBox "Done Did It!"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Bookmarks