Copy sheets with the same name side-by-side

Hi everybody,

I need a VBA that does the following:
1.) it lets me choose the folder where the workbooks are located.
2.) it lets me select the Workbooks that are to be merged
3.) it merges all the workbooks by copying all the sheets with the same names in the selected workbooks,
4.) Copy all the sheets with the same names side by side, into a new worksheet
5.) the Sheets, which do not have the same name, are copied unchanged into the new Workbook
6.) in the new Workbook, the vba deletes all empty columns in all Sheets
7.) finally it lets me choose the place where to save the new marked sheet

The following code does most of it, but it does not copy the whole content of the sheets with the same names, only 2 columns.
I would be grateful if maybe someone could look at the code and correct this error, so that in the sheets with the same names all contents are copied side by side.
I have attached 2 sheets to work with the code.

Thanks for the help in advance.

Here is the code:

Option Explicit

Sub MergeWorkbooks()
    Dim folderPath As String, dialogTitle As String
    Dim fileDialog As fileDialog, selectedWorkbook As Variant
    Dim sourceWorkbook As Workbook, targetWorkbook As Workbook
    Dim targetWorksheet As Worksheet, sourceWorksheet As Worksheet
    Dim lastColumn As Long, copyRange As Range
    
    dialogTitle = "Select the folder where the workbooks are located"
    
    ' Choose folder with workbooks
    Set fileDialog = Application.fileDialog(msoFileDialogFolderPicker)
    With fileDialog
        .Title = dialogTitle
        .AllowMultiSelect = False
        .Show
        folderPath = .SelectedItems(1)
    End With
    
    ' Choose workbooks to merge
    Set fileDialog = Application.fileDialog(msoFileDialogFilePicker)
    With fileDialog
        .Title = "Select the Workbooks to be merged"
        .AllowMultiSelect = True
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xls; *.xlsx; *.xlsm"
        .InitialFileName = folderPath & Application.PathSeparator
        .Show
    End With
    
    ' Create a new workbook to store the merged sheets
    Set targetWorkbook = Workbooks.Add
    
    ' Iterate through selected workbooks
    For Each selectedWorkbook In fileDialog.SelectedItems
        Set sourceWorkbook = Workbooks.Open(selectedWorkbook)
        
        ' Iterate through worksheets in the source workbook
        For Each sourceWorksheet In sourceWorkbook.Worksheets
            Set targetWorksheet = Nothing
            
            ' Check if a worksheet with the same name exists in the target workbook
            On Error Resume Next
            Set targetWorksheet = targetWorkbook.Worksheets(sourceWorksheet.Name)
            On Error GoTo 0
            
            If targetWorksheet Is Nothing Then
                ' If the worksheet does not exist in the target workbook, copy the entire sheet
                sourceWorksheet.Copy After:=targetWorkbook.Worksheets(targetWorkbook.Worksheets.Count)
            Else
                ' If the worksheet exists, copy the used range side by side
                lastColumn = targetWorksheet.Cells(1, targetWorksheet.Columns.Count).End(xlToLeft).Column + 2
                Set copyRange = sourceWorksheet.UsedRange
                copyRange.Copy targetWorksheet.Cells(1, lastColumn)
            End If
        Next sourceWorksheet
        
        sourceWorkbook.Close SaveChanges:=False
    Next selectedWorkbook
    
    ' Choose where to save the new merged workbook
    With Application.fileDialog(msoFileDialogSaveAs)
        .Title = "Choose where to save the new merged workbook"
        .Show
        If .SelectedItems.Count > 0 Then
            targetWorkbook.SaveAs .SelectedItems(1)
        End If
    End With
    
    ' Cleanup
    Set fileDialog = Nothing
    Set sourceWorkbook = Nothing
    Set targetWorkbook = Nothing
    Set targetWorksheet = Nothing
    Set sourceWorksheet = Nothing
    Set copyRange = Nothing
End Sub

Thanks for the help