Skip to content

Instantly share code, notes, and snippets.

@hbekkouche
Created April 29, 2022 11:41
Show Gist options
  • Save hbekkouche/7e82d02f554b1e97be1304700774b1c3 to your computer and use it in GitHub Desktop.
Save hbekkouche/7e82d02f554b1e97be1304700774b1c3 to your computer and use it in GitHub Desktop.
Option Explicit
Sub ConvertToXlsx()
Dim wb As Workbook
Dim sh As Worksheet
Dim myPath As String
Dim myFile As String
Dim myExt As String
Dim myFileName As String
Dim NewWBName As String
Dim ChooseFolder As FileDialog
'Optimize
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'Retrieve Target Folder Path From User
Set ChooseFolder = Application.FileDialog(msoFileDialogFolderPicker)
ChooseFolder.Title = "Select Target Path"
ChooseFolder.AllowMultiSelect = False
If ChooseFolder.Show <> -1 Then GoTo NextCode
myPath = ChooseFolder.SelectedItems(1) & "\"
'Cancel
NextCode:
myPath = myPath
If myPath = "" Then Exit Sub
'File Ext to Change
myExt = "*.xls"
'Target Path with Ending Extention
myFile = Dir(myPath & myExt)
'Loop through each Excel file in folder
Do While myFile <> ""
'Set variable equal to opened workbook
myFileName = Left(myFile, InStr(1, myFile, ".") - 1)
NewWBName = myPath & myFileName & ".xlsx"
Set wb = Workbooks.Open(Filename:=myPath & myFile)
Set sh = wb.Sheets(1)
sh.Rows(1).EntireRow.Delete
sh.Rows(1).EntireRow.Delete
sh.Rows(1).EntireRow.Delete
sh.Rows(1).EntireRow.Delete
sh.Rows(1).EntireRow.Delete
sh.Rows(1).EntireRow.Delete
sh.Rows(1).EntireRow.Delete
sh.Rows(1).EntireRow.Delete
sh.Rows(2).EntireRow.Delete
sh.Rows(2).EntireRow.Delete
sh.Range("A:A").NumberFormat = "@"
sh.Range("A1") = "PAIE"
Dim LR As Long
LR = Cells(Rows.Count, 2).End(xlUp).Row
sh.Range("A2:A" & LR) = myFileName
ActiveWorkbook.SaveAs Filename:=NewWBName, FileFormat:=51
ActiveWorkbook.Close savechanges:=True
'Get next file name
myFile = Dir
Loop
'Reset Macro Optimization Settings
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment