Combining from multiple workbooks

[Budinski]

I will try to be as accurate as possible cos its more complicated than i first thought.

I have multiple WB's all with the same format in a single folder. I need a button to copy all the text from each WB into a single Master WB that has the same format. There are 3 sheets in each client WB corresponding to three sheets in the Master WB. Each client WB has a number of rows (or none) on each sheet and when they are copied to the Master they need to paste consecutively and into the corresponding Master sheet.

Something like this:

Copy rows from [WB1].Sheets 1, 2 and 3 (starting at a:4, columns A-Q). Then paste to corresponding [MasterWB].Sheets 1, 2 and 3 (at a:4, columns A-Q) then repeat with Next Book.

I hope thats clear enough. The Client WB's are all named "stats [name].xls" with 1 hidden sheet (to populate lists) and 3 sheets named "POC", "ISS" and "ECS" repectively. The Master WB is named Stats.xls with the same sheet names as the Client WB's.

The following code was written for me by a helpful member of this forum but it only copies the first sheet of each Client WB. When i tried to duplicate and modify it to copy the second and third sheets I could not get it to copy from the second/third sheets and it meant 3 buttons/3 steps/3 times the confusion.

Sub Report()
a = 1:
st:
If Sheets(5).Cells(a, 1) = "" Then GoTo endd
Path = Sheets(5).Cells(a, 1).Text
If Dir(Path) = "" Then
w = MsgBox(Path + " Is Not A Valid Path / File", , "REPORT")
a = a + 1: GoTo st
End If
Application.ScreenUpdating = False
Workbooks.Open Path
Ro = 4:
st1:
If Cells(Ro, 1) = "" Then GoTo NextBook
 CopyIt Ro
Ro = Ro + 1: GoTo st1
NextBook:
ActiveWorkbook.Close savechanges:=False
a = a + 1: GoTo st
endd:
Application.ScreenUpdating = True
Sheets(1).Activate
End Sub
Sub CopyIt(Ro)
With ThisWorkbook.Sheets(2)
roo = 4
st:
If .Cells(roo, 1) <> "" Then roo = roo + 1: GoTo st
For x = 1 To 17
.Cells(roo, x) = Cells(Ro, x).Text
Next x
End With
End Sub

If there is anyone who could help me with this I would very much appreciate it. I am only a basic user of Excel and VBA is still new to me. Adding modules and understanding basic commands is as much as I know at the moment. Thanks in advance to anyone who has time to work on this.

 

[Budinski]

Yeah, Im thinking I should go on a course

But I need to get this working by next week.

 

[xenou]

This is not tested. Be sure to change the folder name in the code declarations so it is the right folder where your files are found. It is assumed this code is in the master workbook itself. Let me know what problems come up (I can't really believe it will work the first time through).

Alex

Sub Report()
Dim fso As Object
Dim fldr As Object
Dim f As Object
Dim wb As Workbook
Dim ws As Worksheet
Dim wbMaster As Workbook

'------------------------------------------------------
'This must be the folder to find the stats workbooks in
Const fldrToLookIn As String = "C:\MyFolder"
'------------------------------------------------------

'//Reference to master workbook
Set wbMaster = ThisWorkbook

'//Loop through folder
Set fso = CreateObject("Scripting.FileSystemObject")
Set fldr = fso.GetFolder(fldrToLookIn)
ChDir fldr.Name
    
    For Each f In fldr.Files
        If LCase(Left(f.Name, 5)) = "stats" Then
            '//found a stats workbook
            Set wb = Workbooks.Open(Filename:=f.Name, ReadOnly:=True)
            For Each ws In ActiveWorkbook.Worksheets
                '//if sheet name is poc, iss, or ecs, then open, copy, & close
                Select Case LCase(ws.Name)
                    Case "poc", "iss", "ecs"
                        Call CopyIt(wbMaster, ws)
                        wb.Close SaveChanges:=False
                End Select
            Next ws
        End If
    Next f

Set f = Nothing
Set fldr = Nothing
Set fso = Nothing

End Sub
'-------------------------------------------------
Sub CopyIt(ByRef wbMaster As Workbook, ws As Worksheet)
Dim LRowMaster As Long
Dim LRowSource As Long

'//Last row in master workbook sheet; also in sheet to be copied
LRowMaster = GetLastRow(wbMaster.Worksheets(ws.Name))
LRowSource = GetLastRow(ws)

If LRowSource >= 4 Then
    '//If sheet to be copied has data in row 4 or more,
    '            copy it to same sheet in master workbook
    ws.Range("A4:Q" & LRowSource).Copy _
        Destination:=wbMaster.Worksheets(ws.Name).Cells(LRowMaster + 1, 1)
End If
    
End Sub
'-------------------------------------------------
Function GetLastRow(ByRef ws As Worksheet) As Long
'Returns number of last used column on a worksheet
    GetLastRow = ws.Cells.Find("*", ws.[A1], xlFormulas, xlPart, _
        xlByRows, xlPrevious, False, False).Row
End Function

 

[tusharm]

Put the names of the sheets that you want processed in column 2 of the worksheet that contains the file names. Then, run the Report subroutine of the code below. The code is *untested*

Option Explicit

Function CurrRange(aCell As Range) As Range
    If aCell.Value = "" Then
    ElseIf aCell.Offset(1, 0).Value = "" Then
        Set CurrRange = aCell
    Else
        Set CurrRange = aCell.Parent.Range(aCell, aCell.End(xlDown))
        End If
    End Function
Function Max(a, b)
    If a > b Then Max = a Else Max = b
    End Function
Sub processOneWS(ByVal CurrWB As Workbook, ByVal SrcWB As Workbook, _
        ByVal SheetName As String)
    On Error GoTo ErrXIT
    CurrRange(SrcWB.Worksheets(SheetName).Cells(4, 1)).Resize(, 17).Copy
    With CurrWB.Worksheets(SheetName)
    .Cells(Max(4, .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row), 1).xlPasteValues
        End With
ErrXIT:
    End Sub
Sub Report()
    Dim aCell As Range
    Dim FilePath As String, CurrWB As Workbook
    Set CurrWB = ActiveWorkbook
    For Each aCell In CurrRange(CurrWB.Sheets(5).Cells(1, 1))
        Dim aWB As Workbook
        Set aWB = Nothing
        On Error Resume Next
        Set aWB = Application.Workbooks.Open(aCell.Value)
        On Error GoTo 0
        If aWB Is Nothing Then
            MsgBox "Unable to open " & aCell.Value
        Else
            Dim SheetCell As Range, SheetName As String
            For Each SheetCell In CurrRange(CurrWB.Sheets(5).Cells(1, 2))
                Dim aWS As Worksheet
                Set aWS = Nothing
                SheetName = SheetCell.Value
                On Error Resume Next
                Set aWS = aWB.Sheets(SheetName)
                On Error GoTo 0
                If aWS Is Nothing Then
                    MsgBox "File " & aWB.FullName _
                        & " does not have a worksheet named " &

SheetName
Else
processOneWS CurrWB, aWB, SheetName
End If
Next SheetCell
aWB.Close SaveChanges:=False
End If
Next aCell
End Sub

 

[Budinski]

Hi, thanks for your attempt.

I can get this to copy the first sheet (POC) but it is trying to paste the List formulas also and I have to select yes for each instance.

It is not copying the other sheets (ISS, ECS) to the Master sheets of the same name.

Any ideas?

This is not tested. Be sure to change the folder name in the code declarations so it is the right folder where your files are found. It is assumed this code is in the master workbook itself. Let me know what problems come up (I can't really believe it will work the first time through).

Alex

 

[tusharm]

Correctly formatted code. The instructions remain unchanged.

Option Explicit

Function CurrRange(aCell As Range) As Range
    If aCell.Value = "" Then
    ElseIf aCell.Offset(1, 0).Value = "" Then
        Set CurrRange = aCell
    Else
        Set CurrRange = aCell.Parent.Range(aCell, aCell.End(xlDown))
        End If
    End Function
Function Max(a, b)
    If a > b Then Max = a Else Max = b
    End Function
Sub processOneWS(ByVal CurrWB As Workbook, ByVal SrcWB As Workbook, _
        ByVal SheetName As String)
    On Error GoTo ErrXIT
    CurrRange(SrcWB.Worksheets(SheetName).Cells(4, 1)).Resize(, 17).Copy
    With CurrWB.Worksheets(SheetName)
    .Cells(Max(4, .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row), 1).xlPasteValues
        End With
ErrXIT:
    End Sub
Sub Report()
    Dim aCell As Range
    Dim FilePath As String, CurrWB As Workbook
    Set CurrWB = ActiveWorkbook
    For Each aCell In CurrRange(CurrWB.Sheets(5).Cells(1, 1))
        Dim aWB As Workbook
        Set aWB = Nothing
        On Error Resume Next
        Set aWB = Application.Workbooks.Open(aCell.Value)
        On Error GoTo 0
        If aWB Is Nothing Then
            MsgBox "Unable to open " & aCell.Value
        Else
            Dim SheetCell As Range, SheetName As String
            For Each SheetCell In CurrRange(CurrWB.Sheets(5).Cells(1, 2))
                Dim aWS As Worksheet
                Set aWS = Nothing
                SheetName = SheetCell.Value
                On Error Resume Next
                Set aWS = aWB.Sheets(SheetName)
                On Error GoTo 0
                If aWS Is Nothing Then
                    MsgBox "File " & aWB.FullName _
                        & " does not have a worksheet named " & SheetName
                Else
                    processOneWS CurrWB, aWB, SheetName
                    End If
                Next SheetCell
            aWB.Close SaveChanges:=False
            End If
        Next aCell
    End Sub

Put the names of the sheets that you want processed in column 2 of the worksheet that contains the file names. Then, run the Report subroutine of the code below. The code is *untested*
{malformatted code snipped}

 

[Budinski]

Correctly formatted code. The instructions remain unchanged.

Hey,

Thanks for you response also. I have tried this too and it doesnt seem to copy anything to the master. Do I need to change anything to suit my file stucture/formatting?

 

[xenou]

Can you refresh me on the master workbook:

What is its name?
How many sheets?
Which one is hidden?
Which one has a list of file names and in what cells?
Is this code intended to be in the Master workbook?

I'm assuming as you copy rows from other workbooks you will continue to copy them into the same sheets, so the data is "growing" or accumulating, correct - when done you have all the rows from all the other workbooks?

Alex

Also, though it may not be immediately obvious to you, your original code refers to a 5th sheet - is there a fifth sheet of significance in all of this -- sheets(5) -- ?

 

[Budinski]

Can you refresh me on the master workbook:

What is its name? Stats.xls
How many sheets? 5
Which one is hidden? Sheet1
Which one has a list of file names and in what cells? Sheet5, A1 to A13
Is this code intended to be in the Master workbook? Yes

I'm assuming as you copy rows from other workbooks you will continue to copy them into the same sheets, so the data is "growing" or accumulating, correct - when done you have all the rows from all the other workbooks?

This is correct except the clients have a hidden sheet1 and 3 x data sheets named POC, ISS and ECS (this is the same format as the Master except the Master has the added Sheet5 named Base Data). All the client sheets named POC need to 'accumulate' on the master sheet named POC. Then the Client sheets named ISS 'accumulate' on the Master sheet ISS and Client sheets ECS 'accumulate' on the Master sheet ECS.

Also, though it may not be immediately obvious to you, your original code refers to a 5th sheet - is there a fifth sheet of significance in all of this -- sheets(5) -- ?

Thats the sheet5 in the master with the file names as mentioned.

Which one has a list of file names and in what cells? Sheet5, A1 to A13

I know its confusing and I really appreciate the work you are putting into this.