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

  • Hello

    I’m new to Macros and VBA and I was hoping that someone could help me with a task I want to complete, here are the details;


    I 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

    [ATTACH=JSON]{"data-align":"none","data-size":"full","title":"Result_example.png","data-attachmentid":1223255}[/ATTACH]





    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

    [ATTACH=JSON]{"data-align":"none","data-size":"full","title":"Required_result_example.png","data-attachmentid":1223256}[/ATTACH]

    Is this possible???

    Any help would be appreciated.


    Thanks
    Claire

  • Hi Claire,


    Try this



    Gizzmo

  • Hi Gizzmo


    Thanks for getting back to me, when I run the above I get the below error message (I've put the file structure in the red box if it's of any use)




    [ATTACH=JSON]{"data-align":"none","data-size":"custom","height":"449","title":"Error_message.JPG","width":"746","data-attachmentid":1223261}[/ATTACH]



    Thanks for your help!


    Claire

  • Hi Claire,


    Try changing



    Code
    Const strPath As String = "C:\Users\cmarsh\Desktop\group_1"


    To


    Code
    Const strPath As String = "C:\Users\cmarsh\Desktop\group_1\"


    Also see my edit to my original reply as I changed the code to allow for workbook name.


    Gizzmo

  • Change


    Code
    .Sheets("Appendix B").Range("A1:D" & LastRow).Copy wkbDest.Sheets("Master").Cells(2, rLastCell.Column + 1)


    To


    Code
    wkbDest.Sheets("Master").Cells(2, rLastCell.Column + 1).Resize(LastRow, 4).Value = .Sheets("Appendix B").Range("A1:D" & LastRow).Value



    Please note I am assuming your data is always going to be 4 Columns wide...hence "Resize(LastRow,4)" in the code snippet above.

  • Hi I believe it will always be four columns across however I have noticed one or two other projects have six columns so I'm guessing I would just change the "LastRow,4" to "LastRow6"

  • Ok if that's the case, and this is messy, only because I am no expert, but try this code instead, hopefully it will cater for row and column sizes being different between workbooks



    Gizzmo

Participate now!

Don’t have an account yet? Register yourself now and be a part of our community!