How to Paste from multiple Excel workbooks into one workbook (Across the page & file names)

How to paste from multiple Excel workbooks into one workbook (Across the page & file names)

Requirement:

have a folder and in that folder are a number of Excel workbooks. For this task I need to be able to consolidate the data from a range of cells in a particular worksheet (called Appendix B in each one) in these workbooks into one worksheet called Master (in a separate workbook). This is what I have so far in terms of code, and it works great.

Code
Sub CopyRange()
Application.ScreenUpdating = False
Dim wkbDest As Workbook
Dim wkbSource As Workbook
Set wkbDest = ThisWorkbook
Dim LastRow As Long
Const strPath As String = "C:\Users\cmarsh\Desktop\group_1"
ChDir strPath
strExtension = Dir("*.xls*")
Do While strExtension <> ""
Set wkbSource = Workbooks.Open(strPath & strExtension)
With wkbSource
LastRow = .Sheets("Appendix B").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
.Sheets("Appendix B").Range("A1:D" & LastRow).Copy wkbDest.Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
.Close savechanges:=False
End With
strExtension = Dir
Loop
Application.ScreenUpdating = True
End Sub

Result example

However I want to expand on this so that instead of the data going down the page it goes horizontally across the page, I also want to add the source workbook name to the top of each section, please see an example below;

Required result example

[IMG]file:///C:/Users/cmarsh/AppData/Local/Temp/msohtmlclip1/01/clip_image003.jpg[/IMG]

Solution:

Code:

Sub CopyRange()
 Application.ScreenUpdating = False
 Dim wkbDest As Workbook
 Dim wkbSource As Workbook
 Set wkbDest = ThisWorkbook
 Dim LastRow As Long
 Const strPath As String = "C:\Users\cmarsh\Desktop\group_1\"
 ChDir strPath
 strExtension = Dir("*.xls*")
 Do While strExtension <> ""
 Set wkbSource = Workbooks.Open(strPath & strExtension)
 
 Application.ScreenUpdating = True
 
 With wkbSource
 LastRow = .Sheets("Appendix B").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 
Dim rLastCell As Range

Dim rwkbSourceLastCell As Range

Set rLastCell = wkbDest.Sheets("Master").Cells.Find(What:="*", After:=wkbDest.Sheets("Master").Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)


 If rLastCell Is Nothing Then Set rLastCell = wkbDest.Sheets("Master").Cells(1, 1)
 
 wkbDest.Sheets("Master").Cells(2, rLastCell.Column).Offset(-1, 1).Value = wkbSource.Name
 
 
 Set rwkbSourceLastCell = .Sheets("Appendix B").Cells.Find(What:="*", After:=.Sheets("Appendix B").Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
 xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)
 
 
 wkbDest.Sheets("Master").Cells(2, rLastCell.Column + 1).Resize(LastRow, rwkbSourceLastCell.Column).Value = .Sheets("Appendix B").Cells(1, 1).Resize(LastRow, rwkbSourceLastCell.Column).Value
 
 .Close savechanges:=False
 
 End With
 strExtension = Dir
 Loop
 Application.ScreenUpdating = True


End Sub

Obtained from the OzGrid Help Forum.

Solution provided by Gizzmo