Copying data from multiple workbooks to one worksheet

[gelen4o]

Hi,

I use a worksheet where I reconcile data from different reports. All repports have only 1 worksheet and use the same format.

VBA uses GetiOpenFilename with Multiselect enabled so ultimately, I would like Excel to import data from 1 workbook at the time and then continue with the following one from next empty row onwards.

My feeling is that there is something I do wrong with the loop and more specifically with ranges (hence the error message I keep getting "Subscript Out of Range")

Would be most grateful if someone could have a look !

Sub UnaVistaReports()
Dim Reports As Variant
Dim Report As Variant
Dim wsTo As Worksheet
Dim ActivelistWB As Workbook

Set wsTo = Sheets("UnaVista Data")

last = Sheets("UnaVista Data").Range("C" & Rows.Count).End(xlUp).Row

Reports = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*),*.xls*", _
Title:="Select Active List to Import", _
MultiSelect:=True)

If VarType(Reports) = vbBoolean Then
If Not Report Then Exit Sub

End If

For Each Report In Reports

Set ActivelistWB = Workbooks.Open(Report)
ActivelistWB.Sheets(1).UsedRange.Copy
wsTo.Range("C4").PasteSpecial xlPasteValues
ActivelistWB.Close False

Next Report

End Sub

 

[John_w]

You need to update the destination cell for each report. Change the loop to:

    Dim destCell As Range
    
    For Each Report In Reports
        Set destCell = Sheets("UnaVista Data").Range("C" & Rows.Count).End(xlUp).Offset(1)
        Set ActivelistWB = Workbooks.Open(Report)
        ActivelistWB.Sheets(1).UsedRange.Copy
        destCell.PasteSpecial xlPasteValues
        ActivelistWB.Close False
    Next Report

Please use CODE tags - the # icon in the message editor.

 

[Fluff]

I'm not getting an error with this, so it may be your sheet name UnaVista Data is wrong.
As to the rest try this

Sub UnaVistaReports()

    Dim Reports As Variant
    Dim Report As Variant
    Dim wsTo As Worksheet
    Dim ActivelistWB As Workbook
    Dim Last As Long
    
Application.ScreenUpdating = False

    Set wsTo = Sheets("[COLOR=#ff0000]sheet1[/COLOR]")
    
    Reports = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*),*.xls*", _
        Title:="Select Active List to Import", _
        MultiSelect:=True)
    
    If VarType(Reports) = vbBoolean Then
        If Not Report Then Exit Sub
    End If
    
    For Each Report In Reports
    
        Set ActivelistWB = Workbooks.Open(Report)
        Last = wsTo.Range("C" & Rows.Count).End(xlUp).Row
        ActivelistWB.Sheets(1).UsedRange.Copy
        wsTo.Range("C" & Last + 1).PasteSpecial xlPasteValues
        ActivelistWB.Close False
    Application.CutCopyMode = False

    Next Report
Application.ScreenUpdating = True

End Sub

Changing the sheet name in red as needed

 

[gelen4o]

Thank you both for your suggestions. I went with the code proposed by Fluff and it worked right out of the box.

Here is my final VBA and I was wondering if there is a way to shorten the part where values are being replaced towards the end (present it in a more sophisticated and less resource consiming way).

Sub UnaVistaReports()
' clear old UnaVista data
With Sheets(3)
     .Range("C2", .Cells(.Rows.Count, .Columns.Count)).Clear
End With
' Import multiple UnaVista Reports at once
    Dim Reports As Variant
    Dim Report As Variant
    Dim wsTo As Worksheet
    Dim ActivelistWB As Workbook
    Dim Last As Long
    
Application.ScreenUpdating = False
    Set wsTo = Sheets(3)
    
    Reports = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*),*.xls*", _
        Title:="Select Active List to Import", _
        MultiSelect:=True)
    
    If VarType(Reports) = vbBoolean Then
        If Not Report Then Exit Sub
    End If
    
    For Each Report In Reports
    
        Set ActivelistWB = Workbooks.Open(Report)
        Last = wsTo.Range("C" & Rows.Count).End(xlUp).Row
        ActivelistWB.Sheets(1).UsedRange.Copy
        wsTo.Range("C" & Last).PasteSpecial xlPasteValues
        ActivelistWB.Close False
    Application.CutCopyMode = False
    Next Report
Application.ScreenUpdating = True
' last two lines from each UnaVista report
Range("D:D").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
' drag down formulas in A & B to last row used
Dim lastrow As Long
lastrow = Sheets(3).Range("D" & Rows.Count).End(xlUp).Row
Sheets(3).Range("A2:B2").Select
 
Selection.AutoFill Destination:=Sheets(3).Range("A2:B" & lastrow), Type:=xlFillDefault
' Make adjustments to data formatting
Sheets(3).Columns("DD").Select
           Selection.Replace what:="-", replacement:="", lookat:=xlPart, _
           SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
           ReplaceFormat:=False
Sheets(3).Columns("DD").Select
          Selection.Replace what:=" ", replacement:="", lookat:=xlPart, _
           SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
           ReplaceFormat:=False
Sheets(3).Columns("AY").Select
          Selection.Replace what:="-", replacement:="", lookat:=xlPart, _
           SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
           ReplaceFormat:=False
Sheets(3).Columns("AY").Select
          Selection.Replace what:=" ", replacement:="", lookat:=xlPart, _
           SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
           ReplaceFormat:=False


End sub

 

[Fluff]

Thank you both for your suggestions. I went with the code proposed by Fluff and it worked right out of the box.

Glad to help & thanks for the feedback.
As for the replacements

With Sheets(3)
    With .Columns("DD")
        .Replace "-", ""
        .Replace " ", ""
    End With
    With .Columns("AY")
        .Replace "-", ""
        .Replace " ", ""
    End With
End With

It's not much better than what you were doing, but IMO looks a bit neater

 

[gelen4o]

Glad to help & thanks for the feedback.
As for the replacements

With Sheets(3)
    With .Columns("DD")
        .Replace "-", ""
        .Replace " ", ""
    End With
    With .Columns("AY")
        .Replace "-", ""
        .Replace " ", ""
    End With
End With

It's not much better than what you were doing, but IMO looks a bit neater

Many thanks ! You have been tremendous help

 

[codeliftsleep]

Many thanks ! You have been tremendous help

Personally I would get rid of all those select/replace methods and just set the values of the ranges equal to one another. Far quicker and easier. Or just copy and paste using the last blank row as the paste point. However, I am also biased because I am a programmer so I try and write beautiful looking code as much as functional code. VBA makes it a little harder to do it than say C# or Python, but I try and do it nonetheless.

I've also found that the Range.Find method is the only one that works perfectly in all cases to find the last blank row...I've had issues using the other methods.

 

[Fluff]

@gelen4o
Glad to help & thanks for the feedback