How do you merge separate Excel workbooks into one workbook?

[Guest]

We have over 100 Excel workbooks (1 active worksheet in each) that we need to
merge into just one worksheet in one workbook. All worksheets have the same
column headers, but some have more data than others. Is there a quick way to
do this?

 

[Gazeta]

We have over 100 Excel workbooks (1 active worksheet in each) that we need to
merge into just one worksheet in one workbook. All worksheets have the same
column headers, but some have more data than others. Is there a quick way to
do this?

create file with your headers then ust this sub (it works for 2
columns-change it to your area and assumes that if you open your files it
will be ready to copy data i mean activesheet will be the one with data):
Sub merge()
Set active = ActiveSheet

With Application.FileSearch
.NewSearch
.LookIn = "your folder path"
If .LookIn = "" Then Exit Sub
.SearchSubFolders = True
.Filename = "*.xls"
.Execute

Rownumber = 2

Application.ScreenUpdating = False
Application.DisplayAlerts = False

For i = 1 To .FoundFiles.Count
'Open each workbook
Set wb = Workbooks.Open(Filename:=.FoundFiles(i))
Set myrange = Range("a2:b" & Range("a1").CurrentRegion.Rows.Count)
dane.Copy active.Cells(Rownumber, 1)
wiersz = Rownumber + myrange.Rows.Count
ActiveWorkbook.Close

Next
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

mcg

 

[JB]

Consolide WorkBooks of one directory

http://cjoint.com/?ffwaa2fy1C

Sub syntèseClasseursBD()
[A2].CurrentRegion.Offset(1, 0).Resize().Clear
[A2].Select
fenetre = ActiveWorkbook.Name
ChDir ActiveWorkbook.Path ' Directory of actuel workbook
nf = Dir("*.xls") ' First file in the directory
Do While nf <> ""
Workbooks.Open Filename:=nf
Windows(fenetre).Activate
Workbooks(nf).ActiveSheet.[A1].CurrentRegion.Offset(1,
0).Resize().Copy ActiveCell
Workbooks(nf).Close False
[A1].End(xlDown).Offset(1, 0).Select
nf = Dir ' Next file
If nf = ActiveWorkbook.Name Then nf = Dir
Loop
End Sub

Cordialy JB

 

[Guest]

Hi, Gazeta,
As a novice to VB, I'm wondering about two parts of your module below:
1) the word "dane" in front of Copy Active.Cells (Rownumber,1)
2) the word "wiersz" = Rownumber + myrange.Rows.count.

Should I be overriding these to something specific to my spreadsheet? At
this point the Macro runs and nothing happens. Here's what I set up:

Sub merge()
Set Active = ActiveSheet

With Application.FileSearch
..NewSearch
..LookIn = "C:\Documents and Settings\advert\Desktop\Active Accounts"
If .LookIn = "" Then Exit Sub
..SearchSubFolders = True
..Filename = "*.xls"
..Execute

Rownumber = 2

Application.ScreenUpdating = False
Application.DisplayAlerts = False

For i = 1 To .FoundFiles.Count
'Open each workbook
Set wb = Workbooks.Open(Filename:=.FoundFiles(i))
Set myrange = Range("a2:m" & Range("a1").CurrentRegion.Rows.Count)
dane.Copy Active.Cells(Rownumber, 1)
wiersz = Rownumber + myrange.Rows.Count
ActiveWorkbook.Close

Next
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

thanks,
News Gal

 

[Gazeta]

Hi, Gazeta,
As a novice to VB, I'm wondering about two parts of your module below:
1) the word "dane" in front of Copy Active.Cells (Rownumber,1)
2) the word "wiersz" = Rownumber + myrange.Rows.count.

Should I be overriding these to something specific to my spreadsheet? At
this point the Macro runs and nothing happens. Here's what I set up:

Sub merge()
Set Active = ActiveSheet

With Application.FileSearch
.NewSearch
.LookIn = "C:\Documents and Settings\advert\Desktop\Active Accounts"
If .LookIn = "" Then Exit Sub
.SearchSubFolders = True
.Filename = "*.xls"
.Execute

Rownumber = 2

Application.ScreenUpdating = False
Application.DisplayAlerts = False

For i = 1 To .FoundFiles.Count
'Open each workbook
Set wb = Workbooks.Open(Filename:=.FoundFiles(i))
Set myrange = Range("a2:m" & Range("a1").CurrentRegion.Rows.Count)
dane.Copy Active.Cells(Rownumber, 1)
wiersz = Rownumber + myrange.Rows.Count
ActiveWorkbook.Close

Next
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

thanks,
News Gal

sorry i copied this sub from my language
change wiersz to rownumber and dane to myrange
mcg