Konversi Sheet-sheet dalam excel ke single CSV


Problem:
-ada banyak file excel dengan header yang sama
-ditiap excel memiliki beberapa sheet dengan yang header sama juga
-setiap sheet didalam semua excel ingin dirubah ke file2 csv

input
fileXL1.xlsx => sheet1 sheet2 sheet3 sheet4 sheet5
fileXL2.xlsx => sheet1 sheet2 sheet3 sheet4
fileXL3.xlsx => sheet1 sheet2 sheet3 sheet4 sheet5 sheet6

output
1fileXL1.csv
2fileXL1.csv
3fileXL1.csv
4fileXL1.csv
5fileXL1.csv
1fileXL2.csv
2fileXL2.csv
3fileXL2.csv
4fileXL2.csv
1fileXL3.csv
2fileXL3.csv
3fileXL3.csv
4fileXL3.csv
5fileXL3.csv
6fileXL3.csv


Dim directory As String, fileName As String, sheet As Worksheet, I As Integer, j As Integer
Dim WS_Count As Integer
Dim Ix As Integer
Dim MyFileName As String
Dim CurrentWB As Workbook, TempWB As Workbook

Application.ScreenUpdating = False

'sesuaikan direktori file xlsx nya
directory = "D:\Weekly Dashboard\W14\TDD_FDD\xls\"
fileName = Dir(directory & "*.xl??")
k = 0
Do While fileName ""
Workbooks.Open (directory & fileName)
Workbooks(fileName).Activate
WS_Count = ActiveWorkbook.Worksheets.Count

For Ix = 1 To WS_Count

Set CurrentWB = Workbooks(fileName)
Worksheets(Ix).Activate
ActiveWorkbook.ActiveSheet.UsedRange.Copy

Set TempWB = Application.Workbooks.Add(1)
With TempWB.Sheets(1).Range("A1")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With

'Dim Change below to "- 4" to become compatible with .xls files
'sesuaikan dengan target save .csv nya
MyFileName = "D:\Weekly Dashboard\W14\TDD_FDD\csv\" & Ix & Left(CurrentWB.Name, Len(CurrentWB.Name) - 5) & ".csv"
'Range("A2").Value = MyFileName
Application.DisplayAlerts = False
TempWB.SaveAs fileName:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
TempWB.Close SaveChanges:=False
Application.DisplayAlerts = True

k = k + 1

Next Ix

Workbooks(fileName).Close
fileName = Dir()
Loop

Application.ScreenUpdating = True