How to combine multiple workbooks with same structure data

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

BenS - 30 Jan 2007 13:35 GMT

This question has been answered previously, but I need to get the 2nd
worksheet from each workbook. Also, is it possible to do the same thing and
combine ALL worksheets from multiple files into a master spreadsheet.

Using the code below from another user's post (Bernie's code), I am able to
combine the 1st worksheet from multiple workbooks. But who can tell me how
to do the 2nd or ALL worksheets. Thanks for the assistance!

===========

Sub Consolidate()
Dim myBook As Workbook
Dim myCalc As XlCalculation
Dim myShtName As String

With Application
.EnableEvents = False
.DisplayAlerts = False
myCalc = .Calculation
.Calculation = xlCalculationManual
End With

On Error Resume Next
With Application.FileSearch
.NewSearch
'Change this to your directory
.LookIn = "C:\Excel\Files to combine"
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Set myBook = Workbooks.Open(.FoundFiles(i))
myBook.Worksheets(1).Range("A1").CurrentRegion.Copy _
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp)(2)
myBook.Close False
Next i
Else: MsgBox "There were no files found."
End If
End With
With Application
.EnableEvents = True
.DisplayAlerts = True
.Calculation = myCalc
End With

End Sub

Reply to this Message

Bernie Deitrick - 30 Jan 2007 14:59 GMT

Ben,

The first macro below "ConsolidateWithLabels" will do that, putting the name of the workbook source
into column A, and the worksheet source into column B. The second, "ConsolidateWithoutLabels",
doesn't.

HTH,
Bernie
MS Excel MVP

Sub ConsolidateWithLabels()
' Will consolidate Mulitple Sheets
' from Multiple Files onto one sheet
' Never tested with files that would
' give more than one sheets as end result
' Assumes that all data starts in cell A1 and
' is contiguous, with no blanks in column A

With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With

With Application.FileSearch
.NewSearch
'Change this to your directory
.LookIn = ThisWorkbook.Path
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
Set Basebook = ThisWorkbook
For i = 1 To .FoundFiles.Count
If .FoundFiles(i) <> ThisWorkbook.FullName Then
Set myBook = Workbooks.Open(.FoundFiles(i))
For Each mySheet In myBook.Worksheets
mySheet.Activate
Range("A1").CurrentRegion.Copy _
Basebook.Worksheets(1).Range("C65536").End(xlUp).Offset(1, 0)
With Basebook.Worksheets(1)
.Range(.Range("A65536").End(xlUp).Offset(1, 0), _
.Range("C65536").End(xlUp).Offset(0, -2)).Value = _
myBook.Name
.Range(.Range("B65536").End(xlUp).Offset(1, 0), _
.Range("C65536").End(xlUp).Offset(0, -1)).Value = _
mySheet.Name
End With
Next mySheet
myBook.Close
End If
Next i
End If
End With

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

Basebook.SaveAs Application.GetSaveAsFilename

End Sub

Sub ConsolidateWithoutLabels()
' Will consolidate Mulitple Sheets
' from Multiple Files onto one sheet
' Never tested with files that would
' give more than one sheets as end result
' Assumes that all data starts in cell A1 and
' is contiguous, with no blanks in column A

With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With

With Application.FileSearch
.NewSearch
'Change this to your directory
.LookIn = "C:\Excel"
.SearchSubFolders = False 'Change to true if needed
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
Set Basebook = ThisWorkbook
For i = 1 To .FoundFiles.Count
Set myBook = Workbooks.Open(.FoundFiles(i))
For Each mySheet In myBook.Worksheets
mySheet.Activate
Range("A1").CurrentRegion.Copy _
Basebook.Worksheets(1).Range("a65536").End(xlUp).Offset(1, 0)
Next mySheet
myBook.Close
Next i
End If
End With

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

Basebook.SaveAs Application.GetSaveAsFilename

End Sub

> This question has been answered previously, but I need to get the 2nd
> worksheet from each workbook. Also, is it possible to do the same thing and
[quoted text clipped - 42 lines]
>
> End Sub

Reply to this Message

BenS - 31 Jan 2007 13:58 GMT

Ron and Bernie, thank you so much! I got it to work thanks to you.

I can't tell you how much time and effort you have saved me. I'm grateful
and wish you both the best!

> Ben,
>
[quoted text clipped - 149 lines]
> >
> > End Sub

Reply to this Message

samb - 03 Feb 2007 18:54 GMT

Ron and Bernie, I have a problem . . . similar to this one . . . maybe you
can help.

The Excel booklet is on two sheets and I need the data of one sheet merged
into the other . . . so that it properly aligns by name with the first sheet,
(each is a list of names and data; names are the same on both sheets but the
data, (multiple columns), is different except, Common "name numbers" in a
seperate column; column A on one sheet & column H on the second sheet have
the same names by the same names. I don't care how many columns the final
sheet has. There are 920 names and comon numbers per sheet. Thanks

Signature

samb

> Ron and Bernie, thank you so much! I got it to work thanks to you.
>
[quoted text clipped - 154 lines]
> > >
> > > End Sub

Reply to this Message

Bernie Deitrick - 04 Feb 2007 15:10 GMT

You could use a set of VLOOKUP formulas to extract your matching data.

For example:

=VLOOKUP($A1,'Sheet 2'!$H$1:$M$1000,COLUMN()-COLUMN($XXXX$1)+2,False)

Copied down and then over, will extract matching data from Sheet 2 for the
name in column A. Note that the XXXX should be changed to reflect the
column where you first enter this formula: if you enter it in column J, use
J.

If your names are not in the first column of your database, then you will
need to use a combo of INDEX and MATCH to extract the data.

HTH,
Bernie
MS Excel MVP

> Ron and Bernie, I have a problem . . . similar to this one . . . maybe
> you
[quoted text clipped - 179 lines]
>> > >
>> > > End Sub

Reply to this Message

samb - 06 Feb 2007 15:11 GMT

Thanks so much . . . it worked and now I have only one other item to be done
with this matter. On the merged sheet I have a list of many names in one
column; in another column I have numbers (values) that are specific to the
name(s). The same names appear in the name column . . . randomly. I need:
1. For each name to appear only one time in the name column, and
2. For all values in the value column, specific to the corresonding name to
be totaled on the line in the sheet where the name appears in the
corresponding column.

There are approx. 300 names that appear approx. 9000 times, thus 9000 values
to be summed to the 300 names.
Thanks,
Sam

Signature

samb

> You could use a set of VLOOKUP formulas to extract your matching data.
>
[quoted text clipped - 197 lines]
> >> > >
> >> > > End Sub

Reply to this Message

Bernie Deitrick - 06 Feb 2007 15:24 GMT

Sam,

Use a pivot table: select the database, use Data / Pivto Table, click OK.

Then drag the "names" button to the row field, and the "values" button to the data field, and set
the field to SUM rather than COUNT (the default).

HTH,
Bernie
MS Excel MVP

> Thanks so much . . . it worked and now I have only one other item to be done
> with this matter. On the merged sheet I have a list of many names in one
[quoted text clipped - 211 lines]
>> >> > >
>> >> > > End Sub

Reply to this Message

LaRana - 24 May 2007 19:26 GMT

Bernie,

I used the code for "withoutlabels" and it appears to loop through all files
in my folder. However, the resulting file shows a listing of rows 1 from most
of the workbooks. I believe it is overriding the contents everytime it opens
and copies a new workbook. What's wrong? is there a property I need to reset?
I am using excel 2000.

Here is my code:

Sub ConsolidateWithoutLabels()
' Will consolidate Mulitple Sheets
' from Multiple Files onto one sheet
' Never tested with files that would
' give more than one sheets as end result
' Assumes that all data starts in cell A1 and
' is contiguous, with no blanks in column A

With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With

With Application.FileSearch
.NewSearch
'Change this to your directory
.LookIn = "S:\Lsshare\Bankruptcy\Closeouts"
.SearchSubFolders = False 'Change to true if needed
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
Set Basebook = ThisWorkbook
For i = 1 To .FoundFiles.Count
Set myBook = Workbooks.Open(.FoundFiles(i))
For Each mySheet In myBook.Worksheets
mySheet.Activate
Range("A1").CurrentRegion.Copy _
Basebook.Worksheets(1).Range("a65536").End(xlUp).Offset(1, 0)
Next mySheet
myBook.Close
Next i
End If
End With

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

Basebook.SaveAs Application.GetSaveAsFilename

End Sub

> Ben,
>
[quoted text clipped - 149 lines]
> >
> > End Sub

Reply to this Message

Ron de Bruin - 30 Jan 2007 15:01 GMT

For all see
http://www.rondebruin.nl/copy3tip.htm

For the second change

myBook.Worksheets(1).Range("A1").CurrentRegion.Copy

to

myBook.Worksheets(2).Range("A1").CurrentRegion.Copy

For more see
http://www.rondebruin.nl/copy3.htm

Signature

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm

> This question has been answered previously, but I need to get the 2nd
> worksheet from each workbook. Also, is it possible to do the same thing and
[quoted text clipped - 42 lines]
>
> End Sub

Reply to this Message