Sub RenameSheets()
Dim strFolder As String
Dim strFile As String
Dim wbk As Workbook
Dim i As Long
With Application.FileDialog(4) ' msoFileDialogFolderPicker
' Show dialog
If .Show Then
' Assign selected folder to variable
strFolder = .SelectedItems(1)
Else
Beep
Exit Sub
End If
End With
' Append \ if necessary
If Right(strFolder, 1) <> "\" Then
strFolder = strFolder & "\"
End If
On Error GoTo ErrHandler
' Turn off screen updating and event handling
Application.ScreenUpdating = False
Application.EnableEvents = False
' Get first file name in folder
strFile = Dir(strFolder & "*.xls*")
' Loop
Do While strFile <> ""
' Open workbook
Set wbk = Workbooks.Open(Filename:=strFolder & strFile)
' Loop through sheets except first one
' For i = 2 To wbk.Worksheets.Count
' With wbk.Worksheets(i)
' Append " Old" to sheet name
' .Name = .Name & " Old"
'End With
'Next i
Application.DisplayAlerts = False
If wbk.Worksheets.Count > 1 Then
wbk.Worksheets(1).Delete
End If
Application.DisplayAlerts = True
' wbk.Close True
' Close and save workbook
wbk.Close SaveChanges:=True
' Get next file name
strFile = Dir
Loop
ExitHandler:
' Turn on screen updating and event handling
Application.EnableEvents = True
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox Err.Description, vbExclamation
Resume ExitHandler
End Sub
Wednesday, December 18, 2024
macro to delete very first sheet of all excel files in a folder
Subscribe to:
Post Comments (Atom)
No comments:
Post a Comment