Do Until Loop - Transferring data from several workbooks to a Master workbook

Hello all,

I am trying to transfer data from several workbooks (8 at the moment) to a single Master Workbook.

All the headers are the same in all workbooks, the only difference are the number of rows, thus the use of Do Until to identify the last populated row

I have tried using Do Until Loop but I always end up copying and pasting in the same row in my Master workbook.

Here is the code, I see where the problem is but I cannot correct it. (my guess is Range C9 in the loop, it should be dynamic instead but i cant figure out the code to do this)

PS: I'm a beginner in VBA and have always struggled with it

sub import()

Workbooks.Open Filename:="C:Source 1.xlsx"
  
    Range("c9").Select
     
    Do

        Range(Selection, Selection.End(xlToRight)).Select
                Selection.Copy
                ActiveWindow.ActivateNext
                    Range("C9").Select
                    ActiveSheet.Paste
                    
                    ActiveWindow.ActivateNext
                    ActiveCell.Offset(1, 0).Select
                    
        
        ActiveCell.Offset(1, 0).Select

      Loop Until IsEmpty(ActiveCell)
      
            ActiveWindow.ActivateNext
            ActiveCell.Offset(1, 0).Select
            
    Windows("Source 1.xlsx").Activate

    ActiveWindow.Close

end sub

This will not loop each row but get all data into an array at once and paste it into your master sheet at once starting at the next free row

Sub import()
    Dim xlWb As Workbook
    Dim aData, i&
    
    Set xlWb = Workbooks.Open(Filename:="C:Source 1.xlsx")
    
    With xlWb.ActiveSheet
        i = .Cells(8, .Columns.Count).End(xlToLeft).Column  'last column assuming headers are in row 8
        aData = .Range("C9").Resize(.Range("C9").End(xlDown).Row - 8, i - 2).Value  'all data into array
    End With
    
    xlWb.Close False    'close workbook unsaved
    
    With ActiveSheet
        i = .Cells(.Rows.Count, 3).End(xlUp).Row + 1 'last row checking in column C
        .Cells(i, 3).Resize(UBound(aData, 1), UBound(aData, 2)).Value = aData   'paste data
    End With
End Sub

Hi,

in the code form post #2 replace ".Value" with ".FormulaR1C1", you have to do this in 2 places. This will keep the formulas and adjust them to the place they are copied.

GalsenPap,

Welcome to the forum.

I have added code tags to your post. As per forum rule 3, you need to use them whenever you put any code in your post. Please add them in future. In order to put code tags, either type [CODE] before your code and [/CODE] at the end of it, OR you can highlight your code and click the # icon at the top of your post window.

hello,

it is working just fine, thank you very much

as this was done in a testing mode I have tried to implement it at work but now I get an error msg, mainly that the macro can't find the workbook

trying to replace this

Set xlWb = Workbooks.Open(Filename:="C:\Users\****\Desktop\DEV\Test Macro\Source 1.xlsx"),

this is the one that was submitted above and works

with this

Set xlWb = Workbooks.Open(Filename:="C:\Users\****\Desktop\****.xlsx")

basically any other file on my computer

if I just change the address why won't the macro just recognize the new path and apply the same process ?

thanks in advance

Hi,

when the error is saying that it cannot find the workbook you specified in the path it's not due to the macro but the file does not exist or cannot be accessed due to restrictions on windows. e.g. if you are not logged in as admin on your machine but you try to view a desktop of another user.

If it works with SOME files but not with all, there is some rights issue I suppose, or sth with the files, or the path is not correct