Consolidating two WBs using Macro

[haleybusche]

I have two workbooks (WB), A and B. Each has as single worksheet, so I will refer to them as WB A and WB B as there is only one worksheet in each. Each has a dynamic number of rows, A as well as B. The contents of each column is of the same type.

What I need is a macro that will combine the information from WB A column 1 and WB B column 1 to be in row 1 and 2 of Column 1 in a separate combined WB. Continued for a set number of columns (9).

So if I have 3 rows in WB A and 5 rows in WB B I should have 8 rows in the combined WB. But the number of rows in WB A and B will change dynamically, and I will need the combined workbook to accommodate this.

Thanks.

 

[haleybusche]

WB A WS 1

1 2 3 4

A 6 8 9 3

B 5 7 8 7


WB B WS 1
1 2 3 4

A 5 4 8 1

B 8 2 1 6


Combined WB

1 2 3 4

A 6 8 9 3

B 5 7 8 7

C 5 4 8 1

D 8 2 1 6

 

[Domenic]

For the following macro, change the workbook names, accordingly...

[font=Verdana][color=darkblue]Option[/color] [color=darkblue]Explicit[/color]

[color=darkblue]Sub[/color] Consolidate()

    [color=darkblue]Dim[/color] wkbA [color=darkblue]As[/color] Workbook
    [color=darkblue]Dim[/color] wkbB [color=darkblue]As[/color] Workbook
    [color=darkblue]Dim[/color] wksA [color=darkblue]As[/color] Worksheet
    [color=darkblue]Dim[/color] wksB [color=darkblue]As[/color] Worksheet
    [color=darkblue]Dim[/color] wksDest [color=darkblue]As[/color] Worksheet
    [color=darkblue]Dim[/color] LastRow [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] i [color=darkblue]As[/color] [color=darkblue]Long[/color]
    
    Application.ScreenUpdating = [color=darkblue]False[/color]
    
    [color=darkblue]Set[/color] wkbA = Workbooks("Book1.xlsm")   [color=green]'assign the first workbook to a variable[/color]
    [color=darkblue]Set[/color] wksA = wkbA.Worksheets(1)   [color=green]'assign the first worksheet to a variable[/color]
    
    [color=darkblue]Set[/color] wkbB = Workbooks("Book2.xlsm")   [color=green]'assign the second workbook to a variable[/color]
    [color=darkblue]Set[/color] wksB = wkbB.Worksheets(1)   [color=green]'assign the first worksheet to a variable[/color]
    
    [color=darkblue]Set[/color] wksDest = Workbooks.Add(xlWBATWorksheet).Worksheets(1)  [color=green]'open a new workbook with one sheet for the combined data[/color]
    
    [color=darkblue]With[/color] wksA
        .Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).EntireRow.Copy _
            Destination:=wksDest.Cells(wksDest.Rows.Count, "A").End(xlUp).Offset(1) [color=green]'copy the data from the first workbook[/color]
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    
    [color=darkblue]With[/color] wksB
        .Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).EntireRow.Copy _
            Destination:=wksDest.Cells(wksDest.Rows.Count, "A").End(xlUp).Offset(1) [color=green]'copy the data from the second workbook[/color]
    [color=darkblue]End[/color] [color=darkblue]With[/color]
        
    Application.ScreenUpdating = [color=darkblue]True[/color]
        
    MsgBox "Completed...", vbInformation
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
[/font]

 

[haleybusche]

Domenic thank you so much for your response.

I renamed the files to match the workbooks I am referring to. But I am wondering if I am missing something. When I run the code, it is telling me...

"The subscript is out of range" when I debug it is on the following line


Set wkbB = Workbooks("Book2.xlsm")</pre>
Thanks again.

 

[Domenic]

I forgot to mention that the code assumes that both workbooks are already opened. Is this not the case?

 

[haleybusche]

Oh! It can be the case. That worked wonderfully. I am wondering is there a way to copy both workbooks to a specific worksheet in a workbook as opposed to open a new workbook and worksheet?

I am wondering so that I could have some macros already in the worksheet so once the two WBs are combined, I could apply additional macros? As well as some pre-arranged formatting?

This would mean each time I ran the macro, it would have to erase what was already copied in the worksheet from previous runs and then copy the new stuff over.

Would this be possible?

 

[Domenic]

So if I understand you correctly, you want to place this code in the workbook that will be receiving the copied data (destination workbook), and each time the code is run it needs to clear the contents of the specified worksheet from the destination workbook before the data from the two source workbooks is copied to the destination workbook. Is this correct? If so, change the name of the worksheet for the destination workbook and try...

[font=Verdana][color=darkblue]Option[/color] [color=darkblue]Explicit[/color]

[color=darkblue]Sub[/color] Consolidate()

    [color=darkblue]Dim[/color] wkbA [color=darkblue]As[/color] Workbook
    [color=darkblue]Dim[/color] wkbB [color=darkblue]As[/color] Workbook
    [color=darkblue]Dim[/color] wksA [color=darkblue]As[/color] Worksheet
    [color=darkblue]Dim[/color] wksB [color=darkblue]As[/color] Worksheet
    [color=darkblue]Dim[/color] wksDest [color=darkblue]As[/color] Worksheet
    [color=darkblue]Dim[/color] LastRow [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] i [color=darkblue]As[/color] [color=darkblue]Long[/color]
    
    Application.ScreenUpdating = [color=darkblue]False[/color]
    
    [color=darkblue]Set[/color] wkbA = Workbooks("Book1.xlsm")   [color=seagreen]'assign the first workbook to a variable[/color]
    [color=darkblue]Set[/color] wksA = wkbA.Worksheets(1)   [color=seagreen]'assign the first worksheet to a variable[/color]
    
    [color=darkblue]Set[/color] wkbB = Workbooks("Book2.xlsm")   [color=seagreen]'assign the second workbook to a variable[/color]
    [color=darkblue]Set[/color] wksB = wkbB.Worksheets(1)   [color=seagreen]'assign the first worksheet to a variable[/color]
    
    [color=darkblue]Set[/color] wksDest = ThisWorkbook.Worksheets("Sheet1") [color=seagreen]'assign Sheet1 from this workbook to a variable[/color]
    
    wksDest.Cells.ClearContents
    
    [color=darkblue]With[/color] wksA
        .Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).EntireRow.Copy _
            Destination:=wksDest.Cells(wksDest.Rows.Count, "A").End(xlUp).Offset(1) [color=seagreen]'copy the data from the first workbook[/color]
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    
    [color=darkblue]With[/color] wksB
        .Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).EntireRow.Copy _
            Destination:=wksDest.Cells(wksDest.Rows.Count, "A").End(xlUp).Offset(1) [color=seagreen]'copy the data from the second workbook[/color]
    [color=darkblue]End[/color] [color=darkblue]With[/color]
        
    Application.ScreenUpdating = [color=darkblue]True[/color]
        
    MsgBox "Completed...", vbInformation
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

[/font]

 

[haleybusche]

That worked well! Wow, this forum is really great!

Is there a way to copy only certain lines, instead of the whole workbook. For example I need Row 2 and below from WB A and 3 and below from WB B?

And if I wanted only Columns 1-9?

 

[Domenic]

Try replacing...

[font=Verdana]    [color=darkblue]With[/color] wksA
        .Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).EntireRow.Copy _
            Destination:=wksDest.Cells(wksDest.Rows.Count, "A").End(xlUp).Offset(1)
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    
    [color=darkblue]With[/color] wksB
        .Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).EntireRow.Copy _
            Destination:=wksDest.Cells(wksDest.Rows.Count, "A").End(xlUp).Offset(1)
    [color=darkblue]End[/color] [color=darkblue]With[/color]
[/font]

with

[font=Verdana]    [color=darkblue]With[/color] wksA
        .Range("[COLOR="Red"]A2[/COLOR]", .Cells(.Rows.Count, "A").End(xlUp)).[COLOR="Red"]Resize(, 9)[/COLOR].Copy _
            Destination:=wksDest.Cells(wksDest.Rows.Count, "A").End(xlUp).Offset(1)
    End [color=darkblue]With[/color]
    
    [color=darkblue]With[/color] wksB
        .Range("[COLOR="Red"]A3[/COLOR]", .Cells(.Rows.Count, "A").End(xlUp)).[COLOR="Red"]Resize(, 9)[/COLOR].Copy _
            Destination:=wksDest.Cells(wksDest.Rows.Count, "A").End(xlUp).Offset(1)
    End [color=darkblue]With[/color]
        [/font]

 

[haleybusche]

This works for copying and pasting the cells I need. Except it doesn't let me add to the number of rows. Since the worksheet rows are dynamic, I tried adding another row in each WB and then combining the Wbs and it doesn't add the additional row in the combined WB that is in Workbook A or B. The number of rows remains the same. Any ideas?