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 shtFilter = Application.InputBox("请输入工作表过滤字符(没有指定的话输入星号*) : ", "InputBox", , , , , , 2) If shtFilter = False Then shtFilter = "" head = Application.InputBox("请输入表头行数", "InputBox", , , , , , 1) If head = False Then head = 0 endFilter = Application.InputBox("请输入结束行字符(没有指定的话输入星号*) :", "InputBox", , , , , , 2) If endFilter = False Then endFilter = "" tail = Application.InputBox("请输入表尾行数", "InputBox", , , , , , 1) If tail = False Then tail = 0 counter = 0 For Each onesht In wb.Worksheets If onesht.Name Like "*" & shtFilter & "*" Then If onesht.Name <> sht.Name 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("*" & endFilter & "*", .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 End If Next End Sub