Solved i want to change this code to merge two excel files to one sheet side by side. (1 Viewer)

[camiramzi]

this vba code combines multiple excel files into one spreadsheet
how can i change it so it's merging files horizontally next to each other

this is the code

Sub simpleXlsMerger()
    
Dim bookList As Workbook, bFirst As Boolean, ws As Worksheet, wsO As Worksheet
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Dim rCopy As Range

Application.ScreenUpdating = False

Set mergeObj = CreateObject("Scripting.FileSystemObject")

'change folder path of excel files here
Set dirObj = mergeObj.Getfolder("C:\Users\username\Desktop\consolidate\")
Set filesObj = dirObj.Files

For Each everyObj In filesObj
    Set bookList = Workbooks.Open(everyObj)
    For Each ws In bookList.Worksheets
        If Not bFirst Then
            Set wsO = ThisWorkbook.Worksheets.Add()
            wsO.Name = ws.Name
            Set rCopy = ws.Range("A1").CurrentRegion
            'Set rCopy = ws.Range("A1", ws.Range("IV" & Rows.Count)).End(xlUp)
        Else
            Set wsO = ThisWorkbook.Worksheets(ws.Name)
            Set rCopy = ws.Range("A1").CurrentRegion
            Set rCopy = rCopy.Offset(1).Resize(rCopy.Rows.Count - 1)
            ' Set rCopy = ws.Range("A2", ws.Range("IV" & Rows.Count)).End(xlUp)
        End If
        rCopy.Copy wsO.Range("A" & Rows.Count).End(xlUp)(2)
    Next ws
    bookList.Close
    bFirst = True
Next

End Sub

 

[arnelgp]

test this:

Sub simpleXlsMerger()
    
Dim bookList As Workbook, bFirst As Boolean, ws As Worksheet, wsO As Worksheet
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object


'arnelgp
Dim extension As String
Dim lastColumn As Long

Application.ScreenUpdating = False

Set mergeObj = CreateObject("Scripting.FileSystemObject")

'change folder path of excel files here
Set dirObj = mergeObj.Getfolder("C:\Users\username\Desktop\consolidate\")

Set filesObj = dirObj.Files

For Each everyObj In filesObj
    extension = mergeObj.GetExtensionName(everyObj)
    If extension Like "xls*" Then
        Set bookList = Workbooks.Open(everyObj)
        For Each ws In bookList.Worksheets
            If Not bFirst Then
                Set wsO = ThisWorkbook.Worksheets.Add()
                wsO.Name = ws.Name
                bFirst = True
            End If
            With wsO
                lastColumn = .Cells(1, Columns.Count).End(xlToLeft).Column
                If lastColumn <> 1 Then lastColumn = lastColumn + 1
            End With
            ws.Range("A1").CurrentRegion.Copy wsO.Cells(1, lastColumn)
        Next ws
        bookList.Close
        
    End If
Next everyObj

End Sub

 

[camiramzi]

[SIZE=3]arnelgp[/SIZE] you are a legend thank you.​