How can I copy Excel sheets based on their name using VBA? - vba

Question

The background:
I have a directory containing multiple workbooks.
Each workbook contains multiple sheets, both hidden and visible.
I would like to copy one particular sheet from each workbook into an existing master workbook.
The problem:
At the moment, my code copies the first sheet in each source workbook.
I require the code to copy only the sheet called "[current month] Summary", which is most often not the first sheet in the source workbooks.
Because the [current month] will change, it needs to copy the sheet where the last seven letters of the name are "Summary".
My code as it stands:
Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim MyPath As String
Dim strFilename As String
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
Application.EnableEvents = False
Application.ScreenUpdating = False
MyPath = InputBox("Please copy and paste the path to the folder containing the source documents")
Set wbDst = ActiveWorkbook
strFilename = Dir(MyPath & "\*.xls", vbNormal)
If Len(strFilename) = 0 Then Exit Sub
Do Until strFilename = ""
Set wbSrc = Workbooks.Open(Filename:=MyPath & "\" & strFilename)
Set wsSrc = wbSrc.Worksheets(1)
wsSrc.Copy After:=wbDst.Worksheets(wbDst.Worksheets.Count)
wbSrc.Close False
strFilename = Dir()
Loop

Answer 1

Replace this line
Set wsSrc = wbSrc.Worksheets(1)
With
Set wsSrc = wbSrc.Worksheets("[current month] Summary")
Edit:
Replace your current Do Until Code with the below one :)
Do Until strFilename = ""
Set wbSrc = Workbooks.Open(Filename:=MyPath & "\" & strFilename)
For Each ws In wbSrc.Worksheets
If InStr(1, ws.Name, "summary", vbTextCompare) Then
Set wsSrc = ws
End If
Next ws
wsSrc.Copy After:=wbDst.Worksheets(wbDst.Worksheets.Count)
wbSrc.Close False
strFilename = Dir()
Loop

Answer 2

Following code will get the current month and after checking the name in workbooks will give you the desired result:
Dim currMonth As String
currMonth = MonthName(Month(Now))
Do Until strFilename = ""
Set wbSrc = Workbooks.Open(Filename:=MyPath & "\" & strFilename)
For Each ws In wbSrc.Worksheets
If ws.Name = currMonth & "Summary" Then
Debug.Print ws.Name
Set wsSrc = ws
wsSrc.Copy After:=wbDst.Worksheets(wbDst.Worksheets.Count)
Exit For
End If
Next
wbSrc.Close False
strFilename = Dir()
Loop