Copy data from Multiple workbooks simultaneously and paste transpose into One Excel

Marsa.Marsa · Dec 13th 2020

Hi,

I have 140 .xlsx files from which I have to copy cells M3:M8 from sheet "Test" into Once Excel in sheet "Semle". I am using the code that was posted here: Copy data from Multiple workbooks simultaneously into One excluding first row - Excel VBA / Macros - OzGrid Free Excel/VBA Help Forum. It works perfectly except I would like to insert a transpose function as well, since the data I am copying is in rows (M3:M8) and I would like to have it in columns (A:G). Can someone please help me inserting the transpose function, as I did not manage to do it myself (it's my first vba attempt)?

Thank you!

Code

Sub Maybe_Like_So()
Dim wb As String
Application.ScreenUpdating = False
wb = Dir(ThisWorkbook.Path & "\*")
Do Until wb = ""
If wb <> ThisWorkbook.Name Then
Workbooks.Open ThisWorkbook.Path & "\" & wb
With Workbooks(wb).Sheets("Test")
.Range("M3:M8").Copy ThisWorkbook.Sheets("Semle").Cells(Rows.Count, 1).End(xlUp).Offset(1)
End With
Application.CutCopyMode = False
Workbooks(wb).Close False
End If
wb = Dir
Loop
Application.ScreenUpdating = True
End Sub

Display More

**royUK** · Dec 13th 2020

Please read the Forum Rules to understand how the Forum works and why I have added Code Tags to your post

All VBA code posted in the forum must be wrapped in code tags, which you omitted, including single-line code snippets.Be sure to use them in future posts.

How to use code tags

Note: no apostrophe in the tags, just used for demonstration here.

['code]

your code goes between these tags

['/code]

Or, just highlight all of the code and press the <> in the post menu above button to add the code tags.

Thanks.

**royUK** · Dec 13th 2020

Try this

Code

Sub Maybe_Like_So()
Dim wb As String
Application.ScreenUpdating = False
wb = Dir(ThisWorkbook.Path & "\*")
Do Until wb = ""
If wb <> ThisWorkbook.Name Then
Workbooks.Open ThisWorkbook.Path & "\" & wb
With Workbooks(wb).Sheets("Test")
.Range("M3:M8").Copy
With ThisWorkbook.Sheets("Semle")
.Cells(.Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial Transpose:=True
End With
End With
Application.CutCopyMode = False
Workbooks(wb).Close False
End If
wb = Dir
Loop
Application.ScreenUpdating = True
End Sub

Display More

Make sure that you read the Forum Rules before posting again

Marsa.Marsa · Dec 13th 2020

Dear royUK,

I am sorry, will follow the rules in my next post.It works perfectly, thank you!

Marsa.Marsa · Feb 18th 2021

Dear all,

I would like to add another functionality to the code (as written in thread #3). I would also like to sum all number is range I:1 to I:100 and paste it in This workbook as one number in column G (for 140 contracts). I would kindly ask for your help.

Thank you

**Carim** · Feb 18th 2021

Hello,

To make your life easier, you can very easily Consolidate Multiple Excel Files with Power Query

https://www.myexcelonline.com/…kbooks-using-power-query/

Hope this will help

**Carim** · Feb 18th 2021

Thanks for your Like

Power Query is an extremely flexible tool when it comes to consolidating multiple Excel files ...

Share