Copy content from sheets from different workbooks side by side

[CoSinus]

Hi everyone,
i have a lot of excel sheets and have inserted 2 as examples.
All sheets end with -q1 or -q2 etc.

The workbooks contain sheets, which all have the same names.

I would like to copy the sheets with the same names together, i.e. the contents of the sheets that have the same name should be copied next to each other.

For this purpose I would like to select the workbooks that should be copied together with a popup window.

The endings of the worksheets could help to determine the order.
The selected workbooks and the sheets with the same name should be copied in descending order.
I.e. the contents of the sheet with the name 'Cash Flow' from Q7 is copied behind the sheet with the name 'Cash Flow' from Q8; the sheet with the name 'Cash Flow' from Q6 is copied behind the sheet with the name 'Cash Flow' from Q7 and so on.

In total there can be 16 sheets, i.e. the sheet with the ending -q16 is the last one.

I have a code that does this in principle but only for one workbook. I need to copy several workbooks at the same time.

The code also copies the Workbooks beneath each other and not side by side.
I need the workbooks side by side.

I hope you can help me.

Thank you very much.

Here is the Code I have:

Sub KOPIERE_Sheets_WITH_SAME_SHEET_NAME_FROM_OTHER_WORKBOOK_AND_ALL_OTHER()
Application.ScreenUpdating = False
Dim flder As FileDialog, FileName As String, FileChosen As Integer, wkbDest As Workbook, wkbSource As Workbook, WS As Worksheet
Set wkbDest = ThisWorkbook
Set flder = Application.FileDialog(msoFileDialogFilePicker)
flder.Title = "Please Select a folder and file."
FileChosen = flder.Show
FileName = flder.SelectedItems(1)
Set wkbSource = Workbooks.Open(FileName)
With wkbSource
For Each WS In .Sheets
If Not IsError(Evaluate("=ISREF('[" & wkbDest.Name & "]" & WS.Name & "'!$A$1)")) Then
WS.UsedRange.Cells.Copy
With wkbDest.Sheets(WS.Name).Cells(wkbDest.Sheets(WS.Name).Rows.Count, "A").End(xlUp).Offset(2)
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With
Else
WS.Copy after:=wkbDest.Sheets(wkbDest.Sheets.Count)
End If
Next WS
End With
wkbSource.Close False
Application.ScreenUpdating = True
End Sub

[vba_php]

neither one of your books uploaded contains sheets that end with "-q" like you stated. what do you mean by ""beneath each other"" and ""side by side""? not following that.

furthermore, your code:

Please Login or Register  to view this content.

has a few issues, IMO. first, this:

Please Login or Register  to view this content.

is un-necessary. change it to this:

Please Login or Register  to view this content.

2nd, these 2 lines make no sense:

Please Login or Register  to view this content.

because of the first issue I pointed out. you also have no err trap for files selected:

Please Login or Register  to view this content.

there doesn't seem to be anything wrong with this code:

Please Login or Register  to view this content.

and this is obviously fine as well:

Please Login or Register  to view this content.

because the index cap for sheets is the count. the base is 1.

so, if the only issue is the looping of the books. that's easy. it would be something like this, to expand on your original:

Sub KOPIERE_Sheets_WITH_SAME_SHEET_NAME_FROM_OTHER_WORKBOOK_AND_ALL_OTHER() 
Application.ScreenUpdating = False 
Dim wbLOOP As Workbook 'CODE BY ADAM 
Dim c As Long 'CODE BY ADAM 
Dim x As Long 
Dim flder As FileDialog, FileName As String, FileChosen As Integer, wkbDest As Workbook, wkbSource As Workbook, WS As Worksheet 
Set wkbDest = ThisWorkbook 
Set flder = Application.FileDialog(msoFileDialogFilePicker) 
flder.Title = "Please Select a folder and file." 
 
With flder 'CODE BY ADAM 
    .Show 'CODE BY ADAM 
    .AllowMultiSelect = True 'CODE BY ADAM 
End With 'CODE BY ADAM 
 
c = flder.SelectedItems.Count 'CODE BY ADAM 
 
For x = 1 To c 'CODE BY ADAM 
    FileName = flder.SelectedItems(x) 'CODE BY ADAM 
    Set wkbSource = Workbooks.Open(FileName) 'CODE BY ADAM 
 
With wkbSource 
For Each WS In .Sheets 
If Not IsError(Evaluate("=ISREF('[" & wkbDest.Name & "]" & WS.Name & "'!$A$1)")) Then 
WS.UsedRange.Cells.Copy 
With wkbDest.Sheets(WS.Name).Cells(wkbDest.Sheets(WS.Name).Rows.Count, "A").End(xlUp).Offset(2) 
.PasteSpecial xlPasteValues 
.PasteSpecial xlPasteFormats 
End With 
Else 
WS.Copy after:=wkbDest.Sheets(wkbDest.Sheets.Count) 
End If 
Next WS 
End With 
wkbSource.Close False 
 
Next x 'CODE BY ADAM 
 
Application.ScreenUpdating = True 
End Sub  

[CoSinus]

That code works like a charm.
It copies all the contents from sheets with the same name horizontally.

I would please need the contents of the sheets side by side in the ascending order of the q-numbering in the file name,
i.e. sheets with the ending -q5 before -q6 before -q7

Thank you very much