VBA汇总文件夹中的多文件的工作表中不同单元格区域到总表

Sub 提取多文件一工作表中不同区域汇总()
    Dim fileToOpen, x, total_file_path, m, title_row
    Dim MyOb As Object, rng As Range ', rng_1 As Range, rng_2 As Range
    Dim sht2016 As Worksheet, sht2017 As Worksheet, sht2018 As Worksheet
    fileToOpen = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", , "打开文件", , True)
    If TypeName(fileToOpen) = "Boolean" Then MsgBox "你选择了“取消”,将要退出程序": Exit Sub
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Set sht2016 = Worksheets("2016")
    Set sht2017 = Worksheets("2017")
    Set sht2018 = Worksheets("2018")
    sht2016.Range("a5:t300").Clear
    sht2017.Range("a5:t300").Clear
    sht2018.Range("a5:t300").Clear
    m = 0
    On Error Resume Next
    For Each rr In fileToOpen
        Set MyObj = GetObject(rr)
        With MyObj
            With MyObj.Worksheets("Sheet1")
                .Range("a5:t11").Copy
                Lrow = sht2016.Cells.Find("*", Cells(1, 1), , , 1, 2).Row + 1
                sht2016.Range("A" & Lrow).PasteSpecial Paste:=xlPasteValues
                
                .Range("a17:t23").Copy
                Lrow = sht2017.Cells.Find("*", Cells(1, 1), , , 1, 2).Row + 1
                sht2017.Range("A" & Lrow).PasteSpecial Paste:=xlPasteValues
                
                .Range("a29:t35").Copy
                Lrow = sht2018.Cells.Find("*", Cells(1, 1), , , 1, 2).Row + 1
                sht2018.Range("A" & Lrow).PasteSpecial Paste:=xlPasteValues
                m = m + 1
            End With
            .Close False
        End With
        Set MyObj = Nothing
    Next
    On Error GoTo 0
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "完成！共汇总文件数：" & m
End Sub

    '用GetObject打开文件后
        If rn Is Nothing Then
            Set rn = .Range("a5:t11")
        Else
            Set rn = Union(rn, .Range("a5:t11"))
        End If
   '再关闭文件，再循环一次
   '文件循环完成后，判断并且复制
    If Not rn Is Nothing Then
        rn.Copy .Range("A6")
    End If