|
本帖最后由 约定的童话 于 2019-8-19 13:17 编辑
代码发你了,还有不懂得可以加我QQ1975382969咨询
Sub 删除()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim MyPath, MyName, AWbName, Wb As Workbook
MyPath = ActiveWorkbook.Path
MyName = Dir(MyPath & "\" & "*.xls")
AWbName = ActiveWorkbook.Name
Do While MyName <> ""
If MyName <> AWbName Then
Set Wb = Workbooks.Open(MyPath & "\" & MyName)
With Workbooks(1)
ActiveSheet.[B3:B10] = ""
ActiveSheet.[D3:D10] = ""
ActiveSheet.[A14] = ""
ActiveSheet.[A16] = ""
Wb.Close True
End With
End If
MyName = Dir
Loop
MsgBox "删除完毕!", , "报告!"
Application.ScreenUpdating = True
End Sub
|
|