PDA

View Full Version : [SOLVED] Consolidating data from multiple workbooks with varying ranges



Eastwick
03-04-2018, 05:06 PM
Hello, complete Newbie here – I have not posted before and I hope I am doing it correctly;
I have cobbled together code from various parts of the Forums to consolidate data from individual workbooks stored in a folder; the source worksheets all have the same column structure but will have varying numbers of rows; I need to create the “Consolidation” worksheet in the workbook from where the code is run, select and copy the data from each of the (first sheets only) in each of the workbooks in the source directory and paste it into the “Consolidation” worksheet without the headers. I also want to have the worksheet name populated in each row to track where the particular row came from.
I can not effectively select the range – the code falls over at;
Set CopyRng = wb.Worksheets(1).Range(sh.Rows(StartRow), sh.Rows(shLast))
The error message is “Run-time error “91”: Object Variable or With block variable not set”
I have spent much time researching this problem but to no avail – now I think I am suffering mental atrophy!
I have attached a sample “source” workbook – Any help would be greatly appreciated.

21745
Sub ConsolidateData()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim shLast As Long
Dim CopyRng As Range
Dim StartRow As Long
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String

'Optimize Macro Speed
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
.DisplayAlerts = False
End With

'Source Directory
myPath = "c:\source\"


'Source File Extension (must include wildcard "*")
myExtension = "*.xls*"


'Source Path with Ending Extention
myFile = Dir(myPath & myExtension)

' Add a new "Condolidation" worksheet at the left most tab.
Set DestSh = ActiveWorkbook.Worksheets.Add(Before:=Worksheets(1))
DestSh.Name = "Consolidation"


' Fill in the start row.
StartRow = 2

'Loop through each Excel file in Source folder
Do While myFile <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(fileName:=myPath & myFile)

'Ensure Workbook has opened before moving on to next line of code
DoEvents

' Find the last row with data on the summary
' ' and source worksheets.
Last = DestSh.[a65536].End(xlUp).Row
shLast = wb.Worksheets(1).[a65536].End(xlUp).Row

' If source worksheet is not empty and if the last
' row >= StartRow, copy the range.
If shLast > 0 And shLast >= StartRow Then

'Set the range that you want to copy
Set CopyRng = wb.Worksheets(1).Range(sh.Rows(StartRow), sh.Rows(shLast))

' Test to see whether there are enough rows in the summary
' worksheet to copy all the data.
If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
MsgBox "There are not enough rows in the " & _
"summary worksheet to place the data."
GoTo ExitTheSub
End If


' This statement copies values and formats.
CopyRng.Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With


' Optional: This statement will copy the sheet
' name in the H column.
DestSh.Cells(Last + 1, "H").Resize(CopyRng.Rows.Count).Value = sh.Name


End If

'Save and Close Workbook
wb.Close SaveChanges:=True

'Ensure Workbook has closed before moving on to next line of code
DoEvents


'Get next file name
myFile = Dir
Loop



ExitTheSub:


Application.Goto DestSh.Cells(1)


' AutoFit the column width in the summary sheet.
DestSh.Columns.AutoFit


With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

Trebor76
03-04-2018, 08:49 PM
Hi Eastwick,

Welcome to the forum and to a fellow Aussie :)

The issue is that you're trying to assign a range where the sh variable has not yet been set. Putting this line of code...


Set sh = wb.Worksheets(1)

...immediately above this line should do the trick:


Set CopyRng = wb.Worksheets(1).Range(sh.Rows(StartRow), sh.Rows(shLast))

Note the way the code is setting the last row variables in Col. A via a static last row number (65,536) isn't applicable for Excel 2007 as it has 1,048,576 rows. Try this which will work on any version:


Last = DestSh.Cells(Rows.Count, "A").End(xlUp).Row
shLast = wb.Worksheets(1).Cells(Rows.Count, "A").End(xlUp).Row

Regards,

Robert

Eastwick
03-06-2018, 01:04 AM
Trebor76,
Many thanks for your expert guidance - 'works a treat - I was at my wits end - maybe trying to overthink it and missed the basics :-( again, many thanks Cheers :-)
Eastwick

Trebor76
03-06-2018, 02:23 AM
That's for the feedback and you're welcome. I'm glad we were able to provide you with a working solution :)