How do you merge separate Excel workbooks into one workbook?

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?
--
News Gal

U¿ytkownik "Newsgal" <Newsgal@discussions.microsoft.com> napisa³ w
wiadomo¶ci news:16966455-B96B-4792-894F-BABAF6A24E9C@microsoft.com...
> 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?
> --
> News Gal

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

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" wrote:

>
> U¿ytkownik "Newsgal" <Newsgal@discussions.microsoft.com> napisa³ w
> wiadomo¶ci news:16966455-B96B-4792-894F-BABAF6A24E9C@microsoft.com...
> > 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?
> > --
> > News Gal
>
> 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
>

>
>
>
>

U¿ytkownik "Newsgal" <Newsgal@discussions.microsoft.com> napisa³ w
wiadomo¶ci news:5ACE318E-D112-4313-9C61-98B89B678918@microsoft.com...
> 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" wrote:
>
> >
> > U?ytkownik "Newsgal" <Newsgal@discussions.microsoft.com> napisa3 w
> > wiadomo?ci news:16966455-B96B-4792-894F-BABAF6A24E9C@microsoft.com...
> > > 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?
> > > --
> > > News Gal
> >
> > 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


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

Consolide WorkBooks of one directory

http://cjoint.com/?ffwaa2fy1C

Sub synt=E8seClasseursBD()
[A2].CurrentRegion.Offset(1, 0).Resize().Clear
[A2].Select
fenetre =3D ActiveWorkbook.Name
ChDir ActiveWorkbook.Path ' Directory of actuel workbook
nf =3D Dir("*.xls") ' First file in the directory
Do While nf <> ""
Workbooks.Open Filename:=3Dnf
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 =3D Dir ' Next file
If nf =3D ActiveWorkbook.Name Then nf =3D Dir
Loop
End Sub

Cordialy JB