Created
April 29, 2022 11:41
-
-
Save hbekkouche/7e82d02f554b1e97be1304700774b1c3 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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