How can I copy Excel sheets based on their name using 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

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

Answer 2

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