Wednesday, December 18, 2024

macro to delete very first sheet of all excel files in a folder

 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



No comments:

Post a Comment