geomano
06-07-2017, 05:22 AM
Hi,
I am trying to amend my macro, so it will pick up a file staring with particular name, like for instance "Monthly*". Is there any way to do that in VBA? Many thanks for support.
Here's my macro:
Sub HYandQUpdate()
Dim wb As Workbook
Dim wb2 As Workbook
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim myPath As String
Dim wbNames
Dim i As Long
Dim myRange As Range
Application.ScreenUpdating = False
myPath = Application.ActiveWorkbook.Path
wbNames = Array("Half Years", "Quarterly")
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Con")
For i = LBound(wbNames) To UBound(wbNames)
Set wb2 = Workbooks.Open(myPath & "\" & wbNames(i) & ".xls")
For Each ws2 In wb2.Worksheets
Set myRange = ws.Range("A:A").Find(what:=ws2.Name, LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows)
If Not myRange Is Nothing Then
ws2.Range("b4").Value = myRange.Value
ws2.Range("b11").Value = myRange.Offset(, 7).Value
ws2.Range("b2").Value = myRange.Offset(, 4).Value & "/" & myRange.Offset(, 5).Value
ws2.Range("b7").Value = myRange.Offset(, 6).Value
ws2.Range("b12").Value = myRange.Offset(, 13).Value
'
ws2.Range("b5").Value = myRange.Offset(, 3).Value
ws2.Range("b10").Value = myRange.Offset(, 12).Value
ws2.Range("b19").Value = myRange.Offset(, 21).Value
End If
Set myRange = Nothing
Next ws2
'wb2.Save
'wb2.Close
Next i
Application.ScreenUpdating = True
End Sub
I am trying to amend my macro, so it will pick up a file staring with particular name, like for instance "Monthly*". Is there any way to do that in VBA? Many thanks for support.
Here's my macro:
Sub HYandQUpdate()
Dim wb As Workbook
Dim wb2 As Workbook
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim myPath As String
Dim wbNames
Dim i As Long
Dim myRange As Range
Application.ScreenUpdating = False
myPath = Application.ActiveWorkbook.Path
wbNames = Array("Half Years", "Quarterly")
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Con")
For i = LBound(wbNames) To UBound(wbNames)
Set wb2 = Workbooks.Open(myPath & "\" & wbNames(i) & ".xls")
For Each ws2 In wb2.Worksheets
Set myRange = ws.Range("A:A").Find(what:=ws2.Name, LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows)
If Not myRange Is Nothing Then
ws2.Range("b4").Value = myRange.Value
ws2.Range("b11").Value = myRange.Offset(, 7).Value
ws2.Range("b2").Value = myRange.Offset(, 4).Value & "/" & myRange.Offset(, 5).Value
ws2.Range("b7").Value = myRange.Offset(, 6).Value
ws2.Range("b12").Value = myRange.Offset(, 13).Value
'
ws2.Range("b5").Value = myRange.Offset(, 3).Value
ws2.Range("b10").Value = myRange.Offset(, 12).Value
ws2.Range("b19").Value = myRange.Offset(, 21).Value
End If
Set myRange = Nothing
Next ws2
'wb2.Save
'wb2.Close
Next i
Application.ScreenUpdating = True
End Sub