Public Sub simple()
    Set wb = ActiveWorkbook
    Set sht = ActiveSheet
    msg = MsgBox("程序準備清除活動工作表內容？按是確認，按否退出！", vbYesNo, "Tips")
    If msg = vbNo Then Exit Sub
    msg = MsgBox("請您確認是否對本文件做好了備份，宏運行之後不可恢復？按是確認，按否退出！", vbYesNo, "Tips")
    If msg = vbNo Then Exit Sub
    sht.Cells.Clear
    head = Application.InputBox("請輸入表頭行數", "InputBox", , , , , , 1)
    If head = False Then head = 0
    tail = Application.InputBox("請輸入表尾行數", "InputBox", , , , , , 1)
    If tail = False Then tail = 0
    shtFilter = Application.InputBox("請輸入工作表過濾字符 : ", "InputBox", , , , , , 2)
    If shtFilter = False Then shtFilter = ""
    counter = 0
    For Each onesht In wb.Worksheets
        If onesht.Name Like "*" & shtFilter & "*" Then
            counter = counter + 1
            Debug.Print onesht.Name
            With onesht
                If Application.WorksheetFunction.CountA(.Cells) > 0 Then
                    EndCol = 50 ‘ .Cells.Find("*", .Cells(1, 1), xlValues, xlWhole, xlByColumns, xlPrevious).Column
                    
                    EndRow = .Cells.Find("*", .Cells(1, 1), xlValues, xlWhole, xlByRows, xlPrevious).Row
                    If counter = 1 Then
                        Set scrRng = .Range(.Cells(1, "a"), .Cells(EndRow - tail, EndCol))
                        scrRng.Copy sht.Cells(1, 1)
                    Else
                        Set scrRng = .Range(.Cells(head + 1, 1), .Cells(EndRow - tail, EndCol))
                        With sht
                            nextRow = .Cells.Find("*", .Cells(1, 1), xlValues, xlWhole, xlByRows, xlPrevious).Row + 1
                            scrRng.Copy sht.Cells(nextRow, 1)
                        End With
                    End If
                End If
            End With
        End If
    Next
End Sub

20190118_xlVBA多表合並