Memisahkan Sheet di Excel Menjadi File Excel Lain

Malam ini terbesit ide untuk menuliskan tentang sebuah tips dan trik yang saya dapatkan ketika di kantor.

Rekan kerja di kantor saya meminta tolong untuk memisahkan sheet di excel menjadi file excel lain secara terpisah.

Dari sheet-sheet berikut ini:

Dipecah menjadi file-file terpisah seperti ini:

Awalnya saya mau melakukan ini secara manual, namun setelah melakukannya pada beberapa sheet, kok rasanya pekerjaan ini berulang-ulang dan terasa “membosankan”. Dan juga sheet-sheet yang ada ini juga terlalu banyak, kurang lebih ada 20an. Berhubung saya rajin malas (hehehe), maka saya coba riset sedikit di google. “Apakah bisa pekerjaan ini diotomatisasi?” begitu pikir saya  dalam hati.

BANG! Setelah saya googling sedikit, maka ketemu caranya. Ada pada halaman berikut ini . Saya lihat tutorial tersebut dan melihat pada bagian berikut:

Export And Save Worksheets As New Workbook With VBA Code

Tanpa ragu, saya mencobanya. BANG! Berhasil ternyata. Ini magic. Hehehe.

Alhasil saya bisa menghemat waktu untuk menyelesaikan pekerjaan tersebut.

Jadi berikut ini scriptnya. Silahkan mencoba. Dan tutorial lengkapnya ada di sini ya: https://www.extendoffice.com/documents/excel/785-excel-save-export-sheet-as-new-workbook.html

Sub SplitWorkbook() 'Updateby20140612 Dim FileExtStr As String Dim FileFormatNum As Long Dim xWs As Worksheet Dim xWb As Workbook Dim FolderName As String Application.ScreenUpdating = False Set xWb = Application.ThisWorkbook DateString = Format(Now, "yyyy-mm-dd hh-mm-ss") FolderName = xWb.Path & "\" & xWb.Name & " " & DateString MkDir FolderName For Each xWs In xWb.Worksheets xWs.Copy If Val(Application.Version) < 12 Then FileExtStr = ".xls": FileFormatNum = -4143 Else Select Case xWb.FileFormat Case 51: FileExtStr = ".xlsx": FileFormatNum = 51 Case 52: If Application.ActiveWorkbook.HasVBProject Then FileExtStr = ".xlsm": FileFormatNum = 52 Else FileExtStr = ".xlsx": FileFormatNum = 51 End If Case 56: FileExtStr = ".xls": FileFormatNum = 56 Case Else: FileExtStr = ".xlsb": FileFormatNum = 50 End Select End If xFile = FolderName & "\" & Application.ActiveWorkbook.Sheets(1).Name & FileExtStr Application.ActiveWorkbook.SaveAs xFile, FileFormat:=FileFormatNum Application.ActiveWorkbook.Close False Next MsgBox "You can find the files in " & FolderName Application.ScreenUpdating = True End Sub

Semoga bermanfaat untuk rekan-rekan BMKG yang mengalami hal serupa di atas seperti saya. Dan juga semoga bermanfaat untuk para pembaca blog ini.

Berhubung ini masih di pertengahan Ramadhan. Terus tingkatkan ibadah, ya Guys.

See you.

The following two tabs change content below.

mahisaajy

PMG Ahli Pertama, Bidang Manajemen Database at BMKG
Seorang pemuda luar biasa yang mempunyai hobi menulis, membaca, dan bermusik. Tertarik dengan bidang ilmu komputer untuk memecahkan beberapa persoalan. Co-Founder Triglav ID dan Co-Founder METLIGO. Sejak tahun 2018 bekerja di BMKG di bagian Pusat Database.

Leave a Reply

%d bloggers like this: