Appending Contents Of Multiple Spreadsheets Into One

Hello. I would like to open up a new spreadsheet and append rows 2 -
EOF from six other spreadsheets into that new one, be prompted for the
name to save it with, then save and quit. Would someone be kind
enough to offer some VBA code to do this with?
Thank you,
Sheldon Potolsky

Joel
Fri May 09 08:06:02 CDT 2008

Set Sumsht = Worksheets.Add(after:=Sheets(Sheets.Count))
Sumsht.Name = "Summary"
For Each sht In ThisWorkbook.Sheets
If sht.Name <> Sumsht.Name Then
SumLastRow = Sumsht.Range("A" & Rows.Count).End(xlUp).Row
shtLastRow = sht.Range("A" & Rows.Count).End(xlUp).Row
sht.Rows("2:" & shtLastRow).Copy _
Destination:=Sumsht.Rows(SumLastRow + 1)
End If
Next sht

"Sheldon Potolsky" wrote:

> Hello. I would like to open up a new spreadsheet and append rows 2 -
> EOF from six other spreadsheets into that new one, be prompted for the
> name to save it with, then save and quit. Would someone be kind
> enough to offer some VBA code to do this with?
> Thank you,
> Sheldon Potolsky
>

Joel
Fri May 09 08:10:01 CDT 2008

I forgot the SAVEAS

Set Sumsht = Worksheets.Add(after:=Sheets(Sheets.Count))
Sumsht.Name = "Summary"
For Each sht In ThisWorkbook.Sheets
If sht.Name <> Sumsht.Name Then
SumLastRow = Sumsht.Range("A" & Rows.Count).End(xlUp).Row
shtLastRow = sht.Range("A" & Rows.Count).End(xlUp).Row
sht.Rows("2:" & shtLastRow).Copy _
Destination:=Sumsht.Rows(SumLastRow + 1)
End If
Next sht

FName = Application.GetSaveAsFilename( _
fileFilter:="Excel Files (*.xls), *.xls")
If fileSaveName <> False Then
ThisWorkbook.SaveAs Filename:=FName
ThisWorkbook.Close
End If

"Sheldon Potolsky" wrote:

> Hello. I would like to open up a new spreadsheet and append rows 2 -
> EOF from six other spreadsheets into that new one, be prompted for the
> name to save it with, then save and quit. Would someone be kind
> enough to offer some VBA code to do this with?
> Thank you,
> Sheldon Potolsky
>

Ron
Fri May 09 09:16:56 CDT 2008

See also
http://www.rondebruin.nl/copy3.htm

--

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


"Sheldon Potolsky" <SHPsalm139@aol.com> wrote in message news:eca5c476-6e00-4cdb-9d06-3006336d3a4b@d77g2000hsb.googlegroups.com...
> Hello. I would like to open up a new spreadsheet and append rows 2 -
> EOF from six other spreadsheets into that new one, be prompted for the
> name to save it with, then save and quit. Would someone be kind
> enough to offer some VBA code to do this with?
> Thank you,
> Sheldon Potolsky

Sheldon
Mon May 12 07:29:28 CDT 2008

Thank you Ron and Joel for the code to do this.
Sheldon

On May 9, 10:16=A0am, "Ron de Bruin" <rondebr...@kabelfoon.nl> wrote:
> See alsohttp://www.rondebruin.nl/copy3.htm
>
> --
>
> Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm
>
>
>
> "Sheldon Potolsky" <SHPsalm...@aol.com> wrote in messagenews:eca5c476-6e00=
-4cdb-9d06-3006336d3a4b@d77g2000hsb.googlegroups.com...
> > Hello. =A0I would like to open up a new spreadsheet and append rows 2 -
> > EOF from six other spreadsheets into that new one, be prompted for the
> > name to save it with, then save and quit. =A0Would someone be kind
> > enough to offer some VBA code to do this with?
> > Thank you,
> > Sheldon Potolsky- Hide quoted text -
>
> - Hide quoted text -

Sheldon
Mon May 12 08:19:27 CDT 2008

Joel,
I tried running the code you sent and realized that I may not have
been clear on a couple of things.
I actually wanted to append rows 2-EOF from other spreadsheets (and be
prompted for them), and save them in Sheet1 sheet in the blank
spreadsheet I just opened. So, if in my C:\Excel folder I have
Sheldon1.xls, Sheldon2.xls, Sheldon3.xls and Joel1.xls, I would reply
to a prompt for which spreadsheets to include. My response would be
Sheldon*.xls. Rows 2-EOF for all three spreadsheets would be appended
to Sheet1 in my blank spreadsheet. After that your SAVEAS section of
the code would run, I'd select a filename and the new spreadsheet
would be saved and the program would complete.
Thanks, Sheldon

On May 9, 9:10=A0am, Joel <J...@discussions.microsoft.com> wrote:
> I forgot the SAVEAS
>
> Set Sumsht =3D Worksheets.Add(after:=3DSheets(Sheets.Count))
> Sumsht.Name =3D "Summary"
> For Each sht In ThisWorkbook.Sheets
> =A0 =A0If sht.Name <> Sumsht.Name Then
> =A0 =A0 =A0 SumLastRow =3D Sumsht.Range("A" & Rows.Count).End(xlUp).Row
> =A0 =A0 =A0 shtLastRow =3D sht.Range("A" & Rows.Count).End(xlUp).Row
> =A0 =A0 =A0 sht.Rows("2:" & shtLastRow).Copy _
> =A0 =A0 =A0 =A0 =A0Destination:=3DSumsht.Rows(SumLastRow + 1)
> =A0 =A0End If
> Next sht
>
> FName =3D Application.GetSaveAsFilename( _
> =A0 =A0 fileFilter:=3D"Excel Files (*.xls), *.xls")
> If fileSaveName <> False Then
> =A0 =A0 ThisWorkbook.SaveAs Filename:=3DFName
> =A0 =A0 ThisWorkbook.Close
> End If
>
>
>
> "Sheldon Potolsky" wrote:
> > Hello. =A0I would like to open up a new spreadsheet and append rows 2 -
> > EOF from six other spreadsheets into that new one, be prompted for the
> > name to save it with, then save and quit. =A0Would someone be kind
> > enough to offer some VBA code to do this with?
> > Thank you,
> > Sheldon Potolsky- Hide quoted text -
>
> - Show quoted text -

Sheldon
Mon May 12 10:41:30 CDT 2008

Hi Ron. I tried your code (below) but got:
Compile error: Sub or Function not defined (with Get_File_Names
highlighted)
Am I missing something?
Thanks, Sheldon
*****************************
Sub RDB_Merge_Data()
Dim myFiles As Variant
Dim myCountOfFiles As Long

myCountOfFiles =3D Get_File_Names( _
MyPath:=3D"C:\Users\Ron\test", _
Subfolders:=3DFalse, _
ExtStr:=3D"*.xl*", _
myReturnedFiles:=3DmyFiles)

If myCountOfFiles =3D 0 Then
MsgBox "No files that match the ExtStr in this folder"
Exit Sub
End If

Get_Data _
FileNameInA:=3DTrue, _
PasteAsValues:=3DTrue, _
SourceShName:=3D"", _
SourceShIndex:=3D1, _
SourceRng:=3D"A1:G1", _
StartCell:=3D"", _
myReturnedFiles:=3DmyFiles

End Sub

On May 9, 10:16=A0am, "Ron de Bruin" <rondebr...@kabelfoon.nl> wrote:
> See alsohttp://www.rondebruin.nl/copy3.htm
>
> --
>
> Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm
>
>
>
> "Sheldon Potolsky" <SHPsalm...@aol.com> wrote in messagenews:eca5c476-6e00=
-4cdb-9d06-3006336d3a4b@d77g2000hsb.googlegroups.com...
> > Hello. =A0I would like to open up a new spreadsheet and append rows 2 -
> > EOF from six other spreadsheets into that new one, be prompted for the
> > name to save it with, then save and quit. =A0Would someone be kind
> > enough to offer some VBA code to do this with?
> > Thank you,
> > Sheldon Potolsky- Hide quoted text -
>
> - Hide quoted text -

Ron
Mon May 12 12:41:20 CDT 2008

You not copy all the code

Download the example workbook and test it

--

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


"Sheldon Potolsky" <SHPsalm139@aol.com> wrote in message news:00941541-b389-44df-8081-cbb92642ce51@z72g2000hsb.googlegroups.com...
Hi Ron. I tried your code (below) but got:
Compile error: Sub or Function not defined (with Get_File_Names
highlighted)
Am I missing something?
Thanks, Sheldon
*****************************
Sub RDB_Merge_Data()
Dim myFiles As Variant
Dim myCountOfFiles As Long

myCountOfFiles = Get_File_Names( _
MyPath:="C:\Users\Ron\test", _
Subfolders:=False, _
ExtStr:="*.xl*", _
myReturnedFiles:=myFiles)

If myCountOfFiles = 0 Then
MsgBox "No files that match the ExtStr in this folder"
Exit Sub
End If

Get_Data _
FileNameInA:=True, _
PasteAsValues:=True, _
SourceShName:="", _
SourceShIndex:=1, _
SourceRng:="A1:G1", _
StartCell:="", _
myReturnedFiles:=myFiles

End Sub

On May 9, 10:16 am, "Ron de Bruin" <rondebr...@kabelfoon.nl> wrote:
> See alsohttp://www.rondebruin.nl/copy3.htm
>
> --
>
> Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm
>
>
>
> "Sheldon Potolsky" <SHPsalm...@aol.com> wrote in messagenews:eca5c476-6e00-4cdb-9d06-3006336d3a4b@d77g2000hsb.googlegroups.com...
> > Hello. I would like to open up a new spreadsheet and append rows 2 -
> > EOF from six other spreadsheets into that new one, be prompted for the
> > name to save it with, then save and quit. Would someone be kind
> > enough to offer some VBA code to do this with?
> > Thank you,
> > Sheldon Potolsky- Hide quoted text -
>
> - Hide quoted text -

ACarella
Thu Jun 26 16:39:01 CDT 2008

Hi Ron:
I was wondering if you could help me.

I have the following in Excel 2007:
w8001.xlsx
w346.xlsx
w78.xlsx
w172.xlsx

w8001.xlsx has 8 columns and 8001 rows of data
w346.xlsx has 3 columns and 346 rows of data
w78.xlsx has 3 columns and 78 rows of data
w172.xlsx has 3 columns and 172 rows of data

I need to append the three columns (A, B and C) of w346, 278 and w172 to the
END of W8001 and the data to append to the appropriate 3 columns.
How do I proceed.

"Ron de Bruin" wrote:

> You not copy all the code
>
> Download the example workbook and test it
>
> --
>
> Regards Ron de Bruin
> http://www.rondebruin.nl/tips.htm
>
>
> "Sheldon Potolsky" <SHPsalm139@aol.com> wrote in message news:00941541-b389-44df-8081-cbb92642ce51@z72g2000hsb.googlegroups.com...
> Hi Ron. I tried your code (below) but got:
> Compile error: Sub or Function not defined (with Get_File_Names
> highlighted)
> Am I missing something?
> Thanks, Sheldon
> *****************************
> Sub RDB_Merge_Data()
> Dim myFiles As Variant
> Dim myCountOfFiles As Long
>
> myCountOfFiles = Get_File_Names( _
> MyPath:="C:\Users\Ron\test", _
> Subfolders:=False, _
> ExtStr:="*.xl*", _
> myReturnedFiles:=myFiles)
>
> If myCountOfFiles = 0 Then
> MsgBox "No files that match the ExtStr in this folder"
> Exit Sub
> End If
>
> Get_Data _
> FileNameInA:=True, _
> PasteAsValues:=True, _
> SourceShName:="", _
> SourceShIndex:=1, _
> SourceRng:="A1:G1", _
> StartCell:="", _
> myReturnedFiles:=myFiles
>
> End Sub
>
> On May 9, 10:16 am, "Ron de Bruin" <rondebr...@kabelfoon.nl> wrote:
> > See alsohttp://www.rondebruin.nl/copy3.htm
> >
> > --
> >
> > Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm
> >
> >
> >
> > "Sheldon Potolsky" <SHPsalm...@aol.com> wrote in messagenews:eca5c476-6e00-4cdb-9d06-3006336d3a4b@d77g2000hsb.googlegroups.com...
> > > Hello. I would like to open up a new spreadsheet and append rows 2 -
> > > EOF from six other spreadsheets into that new one, be prompted for the
> > > name to save it with, then save and quit. Would someone be kind
> > > enough to offer some VBA code to do this with?
> > > Thank you,
> > > Sheldon Potolsky- Hide quoted text -
> >
> > - Hide quoted text -
>
>