Consolidate Sub-Folder files with a click

Consolidate Sub-Folder files with a click (condition: where file name match with the master file sheets name)

Sub Conslolidate_subFiles()
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim fso As FileSystemObject
Dim Myfl As Folder
Dim Msubf As Folder
Dim fl As File
Dim Fpath As String
Dim Fname As String
Dim RowCount As Double
Dim wkb As ThisWorkbook
Dim sh As Worksheet

Set wkb = Workbooks("Jai_Shri_Ganesh")
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
Fpath = .SelectedItems(1)
End With
Set fso = New FileSystemObject
Set Myfl = fso.GetFolder(Fpath)
    For Each Msubf In Myfl.SubFolders
        For Each fl In Msubf.Files
            Workbooks.Open (fl.Path)
            Sheets("Packing Slip").Activate
            RowCount = Sheets("Packing Slip").Cells(Rows.Count, 1).End(xlUp).Row
            Sheets("Packing Slip").Range("a23: h" & RowCount).Copy
            wkb.Activate
            For Each sh In wkb.Sheets
            If VBA.Mid(Right(fl.Name, 9), 1, 2) = VBA.Right(sh.Name, 2) Then
            wkb.Sheets(sh.Name).Activate
            RowCount = wkb.Sheets(sh.Name).Cells(Rows.Count, 1).End(xlUp).Row
            Sheets(sh.Name).Cells(RowCount + 1, 1).Select
            Selection.PasteSpecial Paste:=xlPasteValues
            ActiveWorkbook.Save
            End If
            Next sh
            Workbooks(fl.Name).Activate
            ActiveWorkbook.Close
            wkb.Save
        Next fl
    Next Msubf
End Sub