copy data from multiple worksheets to a new spreadsheet

[SeekXL]

I have been using Excel for a while but only recently started playing with VBA/Macros and would appreciate help with figuring out my problem here.

There are multiple spreadsheets and each spreadsheet has multiple worksheets, I am trying to loop through each spreadsheet (and the worksheets) and copy the content over to one spreadsheet with the code below

 Dim MyPath As String, FilesInPath As String
    Dim MyFiles() As String
    Dim SourceRcount As Long, FNum As Long
    Dim sourceWB As Workbook, TargetWB As Workbook
    Dim ws As Worksheet
    Dim SourceRange As Range, destRange As Range
    Dim rnum As Long, LastColumn As Long, LastRow As Long
    Dim i As Integer
     
    ' Change this to the path\folder location of your files.
    MyPath = "C:\MyMacros"
    Set TargetWB = Workbooks("Merger")
    
    ' Add a slash at the end of the path if needed.
    If Right(MyPath, 1) <> "\" Then
        MyPath = MyPath & "\"
    End If


    ' If there are no Excel files in the folder, exit.
    FilesInPath = Dir(MyPath & "*.xl*")
    If FilesInPath = "" Then
        MsgBox "No files found"
        Exit Sub
    End If
    
    ' Fill the myFiles array with the list of Excel files
    ' in the search folder.
    FNum = 0
    Do While FilesInPath <> ""
        FNum = FNum + 1
        ReDim Preserve MyFiles(1 To FNum)
        MyFiles(FNum) = FilesInPath
        FilesInPath = Dir()
    Loop
    
    rnum = 3
        ' Loop through all files in the myFiles array.
        If FNum > 0 Then
            For FNum = LBound(MyFiles) To UBound(MyFiles)
                
                On Error Resume Next
                Set sourceWB = Workbooks.Open(MyPath & MyFiles(FNum))
                On Error GoTo 0
                    If Not sourceWB Is Nothing Then
                        
                        For Each ws In sourceWB.Worksheets
                            Select Case ws.Name
                                 Case "Sheet10", "Sheet11"
                                    'do nothing
                                 Case Else
                                    ws.Select
                                    ' get the last column with data in it
                                    LastColumn = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column
                                    ' get the last row with data
                                    LastRow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
                                    Set MyRange = ActiveCell.Range(Cells(3, 1), Cells(LastRow, LastColumn)) 'start from the 3rd row
                                    MyRange.Select
                                    Selection.Copy
                                    With TargetWB.Worksheets(ws.Name).MyRange.Select
                                        Selection.PasteSpecial Paste:=xlPasteValues
                                    End With
                            End Select
                        Next ws
                        sourceWB.Close
                    End If
            Next FNum
            TargetWB.Save
            TargetWB.Close savechanges:=True
        End If

When I step through the code, I see the data being copied from the source spreadsheet but doesnt get pasted in the target spreadsheet.

Questions
1. What is it I should be doing to paste and save the data?
2. Is there a better way of accomplishing this?

Appreciate your suggestions