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