Issue with compiling several open woork books in to one.

[HanAnd]

Hi All,

Having an issue with the following code.
I have a program that exports data in seperate exelfiles, this can sometimes generate a lot of files (10-20 files)
and I needed a function that can combine these in to one single workbook and with the combined data listed on the same sheet.

Now, my problem is that when using this code and I have all these generated and open excel files direclty from my program the code will only sumiraze one of the open files.

However, If I save the opend excel files locally and then open them again, the code works as it should and save all of them in to the same active work.

I cant find the cause for what is making the diffrence from directly generated open excel to opend files that are saved localy.
Can anyone see the issue or familiar with similar problem?

Code as follow:

Sub CombineMultipleSheetsToExisting()
On Error GoTo eh
'declare variables to hold the objects required
Dim wbDestination As Workbook
Dim wbSource As Workbook
Dim wsDestination As Worksheet
Dim wb As Workbook
Dim sh As Worksheet
Dim strSheetName As String
Dim strDestName As String
Dim iRws As Integer
Dim iCols As Integer
Dim totRws As Integer
Dim rngEnd As String
Dim rngSource As Range
'set the active workbook object for the destination book
Set wbDestination = ActiveWorkbook
'get the name of the active file
strDestName = wbDestination.Name
'turn off the screen updating to speed things up
Application.ScreenUpdating = False
'first create new destination worksheet in your Active workbook
Application.DisplayAlerts = False
'resume next error in case sheet doesn't exist
On Error Resume Next
ActiveWorkbook.Sheets("Consolidation").Delete
'reset error trap to go to the error trap at the end
On Error GoTo eh
Application.DisplayAlerts = True
'add a new sheet to the workbook
With ActiveWorkbook
Set wsDestination = .Sheets.Add(After:=.Sheets(.Sheets.Count))
wsDestination.Name = "Consolidation"
End With
'now loop through each of the workbooks open to get the data
For Each wb In Application.Workbooks
If wb.Name <> strDestName And wb.Name <> "PERSONAL.XLSB" Then
Set wbSource = wb
For Each sh In wbSource.Worksheets
'get the number of rows in the sheet
sh.Activate
ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Activate
iRws = ActiveCell.Row
iCols = ActiveCell.Column
rngEnd = sh.Cells(iRws, iCols).Address
Set rngSource = sh.Range("A1:" & rngEnd)
'find the last row in the destination sheet
wbDestination.Activate
Set wsDestination = ActiveSheet
wsDestination.Cells.SpecialCells(xlCellTypeLastCell).Select
totRws = ActiveCell.Row
'check if there are enough rows to paste the data
If totRws + rngSource.Rows.Count > wsDestination.Rows.Count Then
MsgBox "There are not enough rows to place the data in the Consolidation worksheet."
GoTo eh
End If
'add a row to paste on the next row down if you are not in row 1
If totRws <> 1 Then totRws = totRws + 1
rngSource.Copy Destination:=wsDestination.Range("A" & totRws)
Next sh
End If
Next wb
'now close all the open files except the one you want
For Each wb In Application.Workbooks
If wb.Name <> strDestName And wb.Name <> "PERSONAL.XLSB" Then
wb.Close False
End If
Next wb

'clean up the objects to release the memory
Set wbDestination = Nothing
Set wbSource = Nothing
Set wsDestination = Nothing
Set rngSource = Nothing
Set wb = Nothing
'turn on the screen updating when complete
Application.ScreenUpdating = False
Exit Sub
eh:
MsgBox Err.Description
End Sub

Any help would be very appreciated.

BR
Fred

 

[mumps]

Do you simply want to copy all the data in each sheet in the source workbooks into one sheet (Consolidation) in the destination workbook? Why not have the macro open each workbook one at a time, copy/paste the data and then close each one? If this works for you, what is the full path to the folder containing the source files? What is the extension of the files?

 

[FreAnd]

Hi Mumps!

Thanks for your input.

Yes, Just to copy all the data in each sheet from the source workbooks into one sheet in a destination workbook.
The thing is the program that generates these source workbooks just opens these up without saving them to a folder that I can use.

So I need to get the data directly from these already opened workbooks.
This works if I have first saved them locally and then opened them but not when opened directly from the program.

As I am not at work right now I can check if these are .xls or .xlsx could that make a difference?

Again, thankful for the input.

BR
Fred

 

[HanAnd]

Hi again,

Just checked, the file extension is .xlsx

BR
Fred

 

[HanAnd]

Hi again, I have found the issue, The workbooks from my program is opened in seperate instances. Only one of these are included when I open the workbook that will compile everything, dont know why. So I need to find a way to fix that or work around it without generating more work

 

[mumps]

If all the workbooks are open, this macro should work.

Sub CombineMultipleSheetsToExisting()
    Application.ScreenUpdating = False
    Dim desWB As Workbook, desWS As Worksheet, WB As Workbook, WS As Worksheet, lRow1 As Long, lRow2 As Long
    Set desWB = ThisWorkbook
    Set desWS = desWB.Sheets("Consolidation")
    desWS.UsedRange.ClearContents
    For Each WB In Workbooks
        If WB.Name <> desWB.Name And WB.Name <> "PERSONAL.XLSB" Then
            lRow1 = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            For Each WS In WB.Sheets
                lRow2 = WS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                If lRow1 + lRow2 > 1048576 Then
                    MsgBox "There are not enough rows to place the data in the Consolidation worksheet."
                    Exit Sub
                Else
                    With desWS
                        WS.UsedRange.Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
                    End With
                End If
            Next WS
        End If
        Workbooks(WB.Name).Close False
    Next WB
    Application.ScreenUpdating = True
End Sub

 

[HanAnd]

Hi Mumps,

Thank you! But I get the error message Runtime error nr 9 - Index outside intervall (translation from Swedish
Do you know what I might be doing wrong?

 

[mumps]

Which line of code is highlighted when you click "Debug"?

 

[HanAnd]

Hi,
The highlighted line is:
Set desWS = desWB.Sheets("Consolidation")

 

[mumps]

Does that sheet exist in the destination workbook?