Consolidate Workbooks Into Summary Sheet

Hi, I wonder whether someone may be able to help me please.

I'm trying to use this example http://chandoo.org/wp/2012/04/09/con...cel-files-vba/ to consolidate multiple workbookls into one.

I can get the macro to work, but the problem is, is that no matter which cell I use, I cannot get the 'Copy to Location' (column G on the 'List sheet) part of the script to work.

I'm certainly no VBA expert, but I just wondered whether someone may be able to look at this please and offer a little guidance on the changes I need to make to get this to work.

For ease I've included the full script below.

[vba]Public currentWB As Workbook
Public dataWB As Workbook
Public strCopyRange As String

Sub GetData()
Dim strWhereToCopy As String, strStartCellColName As String
Dim strListSheet As String

strListSheet = "List"

On Error GoTo ErrH
Sheets(strListSheet).Select
Range("B2").Select

'this is the main loop, we will open the files one by one and copy their data into the masterdata sheet
Set currentWB = ActiveWorkbook
Do While ActiveCell.Value <> ""

strFileName = ActiveCell.Offset(0, 1) & ActiveCell.Value
strCopyRange = ActiveCell.Offset(0, 2) & ":" & ActiveCell.Offset(0, 3)
strWhereToCopy = ActiveCell.Offset(0, 4).Value
strStartCellColName = Mid(ActiveCell.Offset(0, 5), 2, 1)

Application.Workbooks.Open strFileName, UpdateLinks:=False, ReadOnly:=True
Set dataWB = ActiveWorkbook

Range(strCopyRange).Select
Selection.Copy

currentWB.Activate
Sheets(strWhereToCopy).Select
lastRow = LastRowInOneColumn(strStartCellColName)
Cells(lastRow + 1, 1).Select

Selection.PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
Application.CutCopyMode = False
dataWB.Close False
Sheets(strListSheet).Select
ActiveCell.Offset(1, 0).Select
Loop
Exit Sub

ErrH:
MsgBox "It seems some file was missing. The data copy operation is not complete."
Exit Sub
End Sub

Public Function LastRowInOneColumn(col)
'Find the last used row in a Column: column A in this example
'http://www.rondebruin.nl/last.htm
Dim lastRow As Long
With ActiveSheet
lastRow = .Cells(.Rows.Count, col).End(xlUp).Row
End With
LastRowInOneColumn = lastRow
End Function[/vba]
Many thanks and kind regards

Chris

Avoid using 'Select' and 'Activate' in VBA
I suppose cell A1 is not empty
Then this will suffise:

[VBA]sub M_snb()
sn=thisworkbook.sheets(1).cells(1).currentregion

for j=1 to ubound(sn)
with getobject(sn(j,2))
thisworkbook.sheets(sn(j,5)).cells(rows.count,1).end(xlup).offset(1).resize (range(sn(j,3)&":"&sn(j,4)).rows.count,range(sn(j,3)&":"&sn(j,4)).column.co unt)=.sheets(1).range(range(sn(j,3)&":"&sn(j,4)).value
.close false
end with
next
End Sub[/VBA]

Hi @snb, thank you for taking the time to reply to my post..

I've tried to incorporate your code, but unfortunately, I'm receiving a 'syntax' error on this line:

[VBA] thisworkbook.sheets(sn(j,5)).cells(rows.count,1).end(xlup).offset(1).resize (range(sn(j,3)&":"&sn(j,4)).rows.count,range(sn(j,3)&":"&sn(j,4)).column.co unt)=.sheets(1).range(range(sn(j,3)&":"&sn(j,4)).value[/VBA]

Could you tell me please where I may have gone wrong.

Many thanks and kind regards

Chris

[VBA]ThisWorkbook.Sheets(sn(j, 5)).Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(Range(sn(j, 3) & ":" & sn(j, 4)).Rows.Count, Range(sn(j, 3) & ":" & sn(j, 4)).Column.Count) = .Sheets(1).Range(sn(j, 3) & ":" & sn(j, 4)).Value[/VBA]

Hi @snb , thank you very much for this, this solved the 'syntax' error.

However, unfortunately I unable to paste the data in the cell referenced in column G.

Instead the code still defaults to paste the information in cell A2 rather than my chosern cell of A7.

Many thanks and kind regards

Chris

Analyse the code so you will understand exactly what each expression performs. Then you will be able to change the value of one parameter according to your requirement.

Hi @snb, thank you very much for this.

If I know the solution is in there, I'll work at trying to find it.

Many thanks and kind regards

Chrisd