How to combine multiple workbooks with same structure data

B

BenS

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
 
B

Bernie Deitrick

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
 
B

BenS

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!
 
S

samb

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
 
B

Bernie Deitrick

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
 
S

samb

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
 
B

Bernie Deitrick

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
 
L

LaRana

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

macro - small change 5
open all files in directory 2
Need help editing this code 8
Delete Blank Rows Code - Multiple Worksheets - Multiple Documents 3
Multiple workbooks to one worksheet 3
Merge data from sharepoint workbooks 1
Using VB Code to update one workbook with data from 4 diffferent workbooks. 1
help with merging worksheets 3

Top