我想删除多个Excel工作簿上的工作表。我已经有一些VBA代码可以在单个文件中删除工作表:
Sub delete_sheet()
Application.DisplayAlerts = False
For Each aSheet In Worksheets
Select Case aSheet.Name
Case "INV."
aSheet.Delete
End Select
Next aSheet
Application.DisplayAlerts = True
End Sub
我的文件夹中有500个文件,这些文件都需要删除一个名为“ INV”的选项卡。如何将此操作应用于文件夹中的所有文件?我已经尝试过以下网站提供的示例:https://analystcave.com/vba-run-macro-on-all-files-in-a-folder-all-worksheets-in-a-workbook/:
Sub RunOnAllFilesInFolder()
Dim folderName As String, eApp As Excel.Application, fileName As String
Dim wb As Workbook, ws As Worksheet, currWs As Worksheet, currWb As Workbook
Dim fDialog As Object: Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
Set currWb = ActiveWorkbook: Set currWs = ActiveSheet
'Select folder in which all files are stored
fDialog.Title = "Select a folder"
fDialog.InitialFileName = currWb.Path
If fDialog.Show = -1 Then
folderName = fDialog.SelectedItems(1)
End If
'Create a separate Excel process that is invisibile
Set eApp = New Excel.Application: eApp.Visible = False
'Search for all files in folder [replace *.* with your pattern e.g. *.xlsx]
fileName = Dir(folderName & "\*.*")
Do While fileName <> ""
'Update status bar to indicate progress
Application.StatusBar = "Processing " & folderName & "\" & fileName
Set wb = eApp.Workbooks.Open(folderName & "\" & fileName)
'I tried placing my code here
Sub delete_sheet()
Application.DisplayAlerts = False
For Each aSheet In Worksheets
Select Case aSheet.Name
Case "INV."
aSheet.Delete
End Select
Next aSheet
Application.DisplayAlerts = True
End Sub
wb.Close SaveChanges:=True 'Close opened worbook w/o saving, change as needed
Debug.Print "Processed " & folderName & "\" & fileName
fileName = Dir()
Loop
eApp.Quit
Set eApp = Nothing
'Clear statusbar and notify of macro completion
Application.StatusBar = ""
MsgBox "Completed executing macro on all workbooks"
End Sub
当我尝试执行它时,它使我的excel崩溃了。有什么建议吗?
答案 0 :(得分:1)
您可以执行以下操作:
'...
fileName = Dir(folderName & "\*.*")
Do While fileName <> ""
'Update status bar to indicate progress
Application.StatusBar = "Processing " & folderName & "\" & fileName
Set wb = Workbooks.Open(folderName & "\" & fileName)
Application.DisplayAlerts = False
On Error Resume Next
wb.Worksheets("INV.").Delete
On Error Goto 0
Application.DisplayAlerts = True
wb.Close True 'save changes
fileName = Dir()
Loop
...或者如果您想保留原始的单独子项:
Sub RunOnAllFilesInFolder
'...
fileName = Dir(folderName & "\*.*")
Do While fileName <> ""
'Update status bar to indicate progress
Application.StatusBar = "Processing " & folderName & "\" & fileName
Set wb = Workbooks.Open(folderName & "\" & fileName)
delete_sheet wb, "INV." '<< call your Sub and pass the workbook & sheet name
wb.Close True 'save changes
fileName = Dir()
Loop
'...
End Sub
Sub delete_sheet(wb As Workbook, shtName as String)
Dim aSheet As Worksheet
For Each aSheet In wb.Worksheets
If aSheet.Name = shtName Then
Application.DisplayAlerts = False
aSheet.Delete
Application.DisplayAlerts = True
Exit For 'done looking...
End If
Next aSheet
End Sub