Consolidate workbooks into one workbook

[asudevils5150]

Is there a macro to conslidate let's say 3 workbooks into one workbook. Also, let's assume the each workbook has 5 sheets within each book. I'd like to have the new workbook have each sheet separately. Then I have a macro to combine each sheet into one sheet. Ultimately, I'd like to consolidate each worksheet from various workbooks into one master sheet (within a new workbook).

Any help is greatly appreciated

 

[asudevils5150]

I'm thinking more of blank cells. If I had to pick one, then definitely blank rows over the columns based on your analysis.

 

[Nimrod]

How about this ?

Sub CopyAllOpenBooksVer2()
Dim Sh As Worksheet
Dim Wb As Workbook
For Each Wb In Workbooks
If Not Wb.Name = ThisWorkbook.Name Then
For Each Sh In Wb.Worksheets
On Error Resume Next
ConstRng = Sh.Cells.SpecialCells(xlCellTypeConstants, 3).Address
On Error Resume Next
FormRng = Sh.Cells.SpecialCells(xlCellTypeFormulas, 3).Address
If FormRng = "" Then FormRng = ConstRng
If ConstRng = "" Then ConstRng = FormRng

If Not FormRng = "" And Not ConstRng = "" Then
Union(Sh.Range(FormRng), Sh.Range(ConstRng)).EntireRow.Copy
Range("A" & Cells.SpecialCells(xlCellTypeLastCell).Row + 1).PasteSpecial _
Paste:=xlPasteValues
End If
Next Sh
End If ' WB name not this one
Next Wb
End Sub

 

[Nimrod]

VERSION 3

Take out blanks and add sheet and book names to column z and y

Sub CopyAllOpenBooksVer3()
Dim Sh As Worksheet
Dim Wb As Workbook
For Each Wb In Workbooks
If Not Wb.Name = ThisWorkbook.Name Then
For Each Sh In Wb.Worksheets
On Error Resume Next
ConstRng = Sh.Cells.SpecialCells(xlCellTypeConstants, 3).Address
On Error Resume Next
FormRng = Sh.Cells.SpecialCells(xlCellTypeFormulas, 3).Address
If FormRng = "" Then FormRng = ConstRng
If ConstRng = "" Then ConstRng = FormRng

If Not FormRng = "" And Not ConstRng = "" Then
Start = Cells.SpecialCells(xlCellTypeLastCell).Row + 1
Union(Sh.Range(FormRng), Sh.Range(ConstRng)).EntireRow.Copy
Range("A" & Start).PasteSpecial Paste:=xlPasteValues

' PLACE BOOK NAME IN COLUMN Z AND SHEET NAME IN COLUMN Y
Range("Z" & Start & ":Z" & Cells.SpecialCells(xlCellTypeLastCell).Row) = Wb.Name
Range("Y" & Start & ":Y" & Cells.SpecialCells(xlCellTypeLastCell).Row) = Sh.Name

End If
Next Sh
End If ' WB name not this one
Next Wb
End Sub

 

[asudevils5150]

Thanks so much again!! On the previous macro, again, how do i copy the formulas instaed of the values. Do i just replace a few words? YOur help again is greatly appreciated.

 

[asudevils5150]

Thanks again. I haven't tested the macro yet, but does it take into account transferring the formulas..for instance, if i have a cell in date format, the previous version had converted that cell into that weird five digit date thingie...

Thanks Nimrod

 

[asudevils5150]

Hello,

As you can tell, I'm working on a big project. Your first code worked great, but for some reason, the next 2 did not work out for me. But that's most likely my error, not yours. Anyways, if we can work on the first code you gave, how do i add the "Tracking Column" in let's say Columns Z and Y as you wrote in the second code. I tried to just copy those three lines into the first code, but got an error. If I can just copy those three lines, where would i place them within the first code.

As for the other post you did on the "collect from and xls directory", that's way complicated for me. I'm a beginner in this VBA code, but I'm trying to learn quickly.

Thanks again. Your response would be greatly appreciated. To summarize, i just want to add the source columns to the first code you wrote. I'll worry about getting blank cells and rows/columns later

 

[Nimrod]

The date issue has got to do with the cell format. So I've included a line of code to copy over the format as well as the values from a cell. The current version has been tweeked ohter ways as well so please give it a try . If it doesn't work could you give me a little detail of what's happening.
Also make sure that all xls sheets are open in the same "instance" of excel. That is to say you should be able to goto the Window command on the tool bar and see a list of the books , including the one with the code.

Sub CopyAllOpenBooksVer4()
Dim Sh As Worksheet
Dim Wb As Workbook
For Each Wb In Workbooks
If Not Wb.Name = ThisWorkbook.Name Then
For Each Sh In Wb.Worksheets
On Error Resume Next
ConstRng = Sh.Cells.SpecialCells(xlCellTypeConstants, 3).Address
On Error Resume Next
FormRng = Sh.Cells.SpecialCells(xlCellTypeFormulas, 3).Address
If FormRng = "" Then FormRng = ConstRng
If ConstRng = "" Then ConstRng = FormRng

If Not FormRng = "" And Not ConstRng = "" Then
Start = Cells.SpecialCells(xlCellTypeLastCell).Row + 1
Union(Sh.Range(FormRng), Sh.Range(ConstRng)).EntireRow.Copy
Range("A" & Start).PasteSpecial Paste:=xlPasteValues
Range("A" & Start).PasteSpecial Paste:=xlPasteFormats


' PLACE BOOK NAME IN COLUMN X AND SHEET NAME IN COLUMN Y
Range("Z" & Start & ":Z" & Cells.SpecialCells(xlCellTypeLastCell).Row) = Wb.Name
Range("Y" & Start & ":Y" & Cells.SpecialCells(xlCellTypeLastCell).Row) = Sh.Name
FormRng = ""
ConstRng = ""
End If
Next Sh
End If ' WB name not this one
Next Wb
End Sub

 

[asudevils5150]

Hello again.

I tried the Macro, but for some reason, it actually copied the text of the subroutine on the workbook. I'm using Excel 97...does that help you any?

Thanks,
Ron