Tuesday 4 April 2023

Gabung File Excel Menjadi Satu

 Cara menggabung beberapa file excel menjadi 1 file dengan beberapa sheet

Tekan Alt+F11 kemudian masukan comman berikut 


Sub MergeExcelFiles()

     Dim fnameList, fnameCurFile As Variant

     Dim countFiles, countSheets As Integer

     Dim wksCurSheet As Worksheet

     Dim wbkCurBook, wbkSrcBook As Workbook


     fnameList = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel files to merge", MultiSelect:=True)


     If (vbBoolean <> VarType(fnameList)) Then


     If (UBound(fnameList) > 0) Then

     countFiles = 0

     countSheets = 0


     Application.ScreenUpdating = False

     Application.Calculation = xlCalculationManual


     Set wbkCurBook = ActiveWorkbook


     For Each fnameCurFile In fnameList

     countFiles = countFiles + 1


     Set wbkSrcBook = Workbooks.Open(Filename:=fnameCurFile)


     For Each wksCurSheet In wbkSrcBook.Sheets

     countSheets = countSheets + 1

     wksCurSheet.Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)

Next


     wbkSrcBook.Close SaveChanges:=False


     Next


     Application.ScreenUpdating = True

     Application.Calculation = xlCalculationAutomatic


     MsgBox "Processed " & countFiles & " files" & vbCrLf & "Merged " & countSheets & " worksheets", Title:="Merge Excel files"

     End If


     Else

     MsgBox "No files selected", Title:="Merge Excel files"

     End If

     End Sub



Selanjutnya Run, kemudian pilih file excel yang akan digabung dalam satu file namun dalam beberapa sheet. selanjutnya jika masing-masing sheet memiliki header yg sama kemudian akan kita gabung jadi 1 sheet maka kita gunakan rumus VBA seperti berikut, dengan menggunakan Alt+F11 lalu masukan script berikut 

Sub Combine()
'UpdateByKutools20151029
    Dim i As Integer
    Dim xTCount As Variant
    Dim xWs As Worksheet
    On Error Resume Next
LInput:
    xTCount = Application.InputBox("The number of title rows", "", "1")
    If TypeName(xTCount) = "Boolean" Then Exit Sub
    If Not IsNumeric(xTCount) Then
        MsgBox "Only can enter number", , "Kutools for Excel"
        GoTo LInput
    End If
    Set xWs = ActiveWorkbook.Worksheets.Add(Sheets(1))
    xWs.Name = "Combined"
    Worksheets(2).Range("A1").EntireRow.Copy Destination:=xWs.Range("A1")
    For i = 2 To Worksheets.Count
        Worksheets(i).Range("A1").CurrentRegion.Offset(CInt(xTCount), 0).Copy _
               Destination:=xWs.Cells(xWs.UsedRange.Cells(xWs.UsedRange.Count).Row + 1, 1)
    Next
End Sub



Maka semua sheet akan tergabung dalam 1 sheet dengan nama combined.

0 comments:

Post a Comment