Import Excel 2 Excel

  1. 9 bulan yang lalu
    Di sunting 9 bulan yang lalu oleh alan13

    Hampir sama seperti sebelumnya Import CSV. Kali ini saya mencoba untuk import data dari excel (xls dan xlsx) ke dalam excel master.

    Ini beberapa code yang sudah saya dapatkan:

    Public Sub myRead()
        Dim sPathName As String, sFileName As String
        Dim SourceWB As Workbook, WS As Worksheet
        Dim xlSheet As Worksheet, sSheetName As String
    
        Application.ScreenUpdating = False
    
        sPathName = ThisWorkbook.Path & "\"
        sFileName = Dir(sPathName & "*.xls?", vbNormal)
    
        'Setiap WorkBook pada folder
        Do While Len(sFileName) > 0
            Set xlSheet = ThisWorkbook.Worksheets.Add(after:=Sheets(ThisWorkbook.Worksheets.Count))
            
            sFileName = sPathName & sFileName
            SourceWB = Workbooks.Open(sFileName)
            
            'Setiap sheet pada WorkBook
            For Each WS In SourceWB.Worksheets
                WS.Copy after:=WB.Sheets(WB.Sheets.Count)
                
                'Rename Sheet
                If Len(sSheetName) > 31 Then
                        sSheetName = Left$(sSheetName, 31)
                End If
                xlSheet.Name = sSheetName
            Next WS
            
            sFileName = Dir
        Loop
        
        Application.ScreenUpdating = True
        Application.EnableEvents = True
    End Sub

    Mohon pencerahannya :D

    Public Sub myImport()
        Dim sPathName As String, sFileName As String
        Dim sourceWb As Workbook, targetWb As Workbook
        Dim sh As Worksheet
        Set sourceWb = ActiveWorkbook
        
        sPathName = ThisWorkbook.Path & "\"
        sFileName = Dir(sPathName & "*.xls", vbNormal)
        
        Do While Len(sFileName) > 0
            sFileName = sPathName & sFileName
            
            Set targetWb = Workbooks.Open(sFileName)
            For Each sh In targetWb.Worksheets
                sh.Copy After:=sourceWb.Sheets(sourceWb.Sheets.Count)
            Next sh
            targetWb.Close
            
            sFileName = Dir
        Loop
    End Sub

    Thx all.

  2. alan13

    8 Peb 2018 Jawaban Terpilih + 174 Poin
    Di sunting 9 bulan yang lalu oleh alan13
    Public Sub myImport()
        Dim sPathName As String, sFileName As String
        Dim sourceWb As Workbook, targetWb As Workbook
        Dim sh As Worksheet
        Set sourceWb = ActiveWorkbook
        
        sPathName = ThisWorkbook.Path & "\"
        sFileName = Dir(sPathName & "*.xls", vbNormal)
        
        Do While Len(sFileName) > 0
            sFileName = sPathName & sFileName
            
            Set targetWb = Workbooks.Open(sFileName)
            For Each sh In targetWb.Worksheets
                sh.Copy After:=sourceWb.Sheets(sourceWb.Sheets.Count)
            Next sh
            targetWb.Close
            
            sFileName = Dir
        Loop
    End Sub

    Thx all.

 

atau Mendaftar untuk ikut berdiskusi!