Copy Worksheet to a new Workbook creating if it doesn't exist and add more Worksheets if it does exist

Help Please with VBA

I would like to copy a worksheet from an active workbook creating a new
workbook if it does not exist. If it exists just to add the worksheet
to it. Also need it to overwrite a sheet with the same name.

I am using code to save the sheet by cell references and can get as far
as saving to a new workbook, but cannot get to add a sheet, only to
overwrite the file.

Sounded so simply when i started!! All help greatly appreciated.

Regards and Thanks


Peter

assume you mean if the workbook is open in excel

Dim bk as Workbook, sh as worksheet
on Error resume next
set bk = workbooks("Destination.xls")
if not bk is nothing then
set sh = bk.worksheets("SheetName")
if not sh is nothing then
application.Displayalerts = False
sh.Delete
application.DisplayAlerts = True
end if
else
set bk = workbooks.Add()
bk.SaveAs "C:\Myfolder\Destination.xls"
end if
On Error goto 0
thisworkbook.Worksheets("SheetName").copy _
After:=bk.sheets(bk.sheets.count)
bk.Save

--
Regards,
Tom Ogilvy



"[email protected]" wrote:

> Help Please with VBA
>
> I would like to copy a worksheet from an active workbook creating a new
> workbook if it does not exist. If it exists just to add the worksheet
> to it. Also need it to overwrite a sheet with the same name.
>
> I am using code to save the sheet by cell references and can get as far
> as saving to a new workbook, but cannot get to add a sheet, only to
> overwrite the file.
>
> Sounded so simply when i started!! All help greatly appreciated.
>
> Regards and Thanks
>
>
> Peter
>
>

Many thanks that worked perfectly, could i trouble you for a small
revision?

The worksheet names and workbook names will be variable as i change
them from data from the worksheet cells.

Is it possible to instead of "Destination.xls" make it the contents of
cells A1 and A2?

Is it possible instead of it being "sheetname" to be whatever the
worksheet name is?

Learning something new everyday.

Many Thanks


Peter

Tom Ogilvy wrote:

> assume you mean if the workbook is open in excel
>
> Dim bk as Workbook, sh as worksheet
> on Error resume next
> set bk = workbooks("Destination.xls")
> if not bk is nothing then
> set sh = bk.worksheets("SheetName")
> if not sh is nothing then
> application.Displayalerts = False
> sh.Delete
> application.DisplayAlerts = True
> end if
> else
> set bk = workbooks.Add()
> bk.SaveAs "C:\Myfolder\Destination.xls"
> end if
> On Error goto 0
> thisworkbook.Worksheets("SheetName").copy _
> After:=bk.sheets(bk.sheets.count)
> bk.Save
>
> --
> Regards,
> Tom Ogilvy
>
>
>
> "[email protected]" wrote:
>
> > Help Please with VBA
> >
> > I would like to copy a worksheet from an active workbook creating a new
> > workbook if it does not exist. If it exists just to add the worksheet
> > to it. Also need it to overwrite a sheet with the same name.
> >
> > I am using code to save the sheet by cell references and can get as far
> > as saving to a new workbook, but cannot get to add a sheet, only to
> > overwrite the file.
> >
> > Sounded so simply when i started!! All help greatly appreciated.
> >
> > Regards and Thanks
> >
> >
> > Peter
> >
> >

Dim bk as Workbook, sh as worksheet
Dim sbk as String, ssh as String

sbk = Range("A1").Value & Range("A2").Value
ssh = ????
on Error resume next
set bk = workbooks(sBk)
if not bk is nothing then
set sh = bk.worksheets(ssh)
if not sh is nothing then
application.Displayalerts = False
sh.Delete
application.DisplayAlerts = True
end if
else
set bk = workbooks.Add()
bk.SaveAs "C:\Myfolder\" & sb1
end if
On Error goto 0
thisworkbook.Worksheets(ssh).copy _
After:=bk.sheets(bk.sheets.count)
bk.Save

--
Regards,
Tom Ogilvy
<[email protected]> wrote in message
news:[email protected]...
> Many thanks that worked perfectly, could i trouble you for a small
> revision?
>
> The worksheet names and workbook names will be variable as i change
> them from data from the worksheet cells.
>
> Is it possible to instead of "Destination.xls" make it the contents of
> cells A1 and A2?
>
> Is it possible instead of it being "sheetname" to be whatever the
> worksheet name is?
>
> Learning something new everyday.
>
> Many Thanks
>
>
> Peter
>
> Tom Ogilvy wrote:
>
> > assume you mean if the workbook is open in excel
> >
> > Dim bk as Workbook, sh as worksheet
> > on Error resume next
> > set bk = workbooks("Destination.xls")
> > if not bk is nothing then
> > set sh = bk.worksheets("SheetName")
> > if not sh is nothing then
> > application.Displayalerts = False
> > sh.Delete
> > application.DisplayAlerts = True
> > end if
> > else
> > set bk = workbooks.Add()
> > bk.SaveAs "C:\Myfolder\Destination.xls"
> > end if
> > On Error goto 0
> > thisworkbook.Worksheets("SheetName").copy _
> > After:=bk.sheets(bk.sheets.count)
> > bk.Save
> >
> > --
> > Regards,
> > Tom Ogilvy
> >
> >
> >
> > "[email protected]" wrote:
> >
> > > Help Please with VBA
> > >
> > > I would like to copy a worksheet from an active workbook creating a
new
> > > workbook if it does not exist. If it exists just to add the worksheet
> > > to it. Also need it to overwrite a sheet with the same name.
> > >
> > > I am using code to save the sheet by cell references and can get as
far
> > > as saving to a new workbook, but cannot get to add a sheet, only to
> > > overwrite the file.
> > >
> > > Sounded so simply when i started!! All help greatly appreciated.
> > >
> > > Regards and Thanks
> > >
> > >
> > > Peter
> > >
> > >
>

Thanks for the help,

I think i was right to change sb1 to sbk? if not it might explain my
problem!!

When the worksheet is copied to the new workbook, i lose some of the
data in cells with a certain formula (i'll work on changing that),
however it might be easier if the worksheet is just created in the new
worksheet as values, formats, column widths and that should remove the
problem.

Thanks again for all your help.

Peter

Tom Ogilvy wrote:

> Dim bk as Workbook, sh as worksheet
> Dim sbk as String, ssh as String
>
> sbk = Range("A1").Value & Range("A2").Value
> ssh = ????
> on Error resume next
> set bk = workbooks(sBk)
> if not bk is nothing then
> set sh = bk.worksheets(ssh)
> if not sh is nothing then
> application.Displayalerts = False
> sh.Delete
> application.DisplayAlerts = True
> end if
> else
> set bk = workbooks.Add()
> bk.SaveAs "C:\Myfolder\" & sb1
> end if
> On Error goto 0
> thisworkbook.Worksheets(ssh).copy _
> After:=bk.sheets(bk.sheets.count)
> bk.Save
>
> --
> Regards,
> Tom Ogilvy
> <[email protected]> wrote in message
> news:[email protected]...
> > Many thanks that worked perfectly, could i trouble you for a small
> > revision?
> >
> > The worksheet names and workbook names will be variable as i change
> > them from data from the worksheet cells.
> >
> > Is it possible to instead of "Destination.xls" make it the contents of
> > cells A1 and A2?
> >
> > Is it possible instead of it being "sheetname" to be whatever the
> > worksheet name is?
> >
> > Learning something new everyday.
> >
> > Many Thanks
> >
> >
> > Peter
> >
> > Tom Ogilvy wrote:
> >
> > > assume you mean if the workbook is open in excel
> > >
> > > Dim bk as Workbook, sh as worksheet
> > > on Error resume next
> > > set bk = workbooks("Destination.xls")
> > > if not bk is nothing then
> > > set sh = bk.worksheets("SheetName")
> > > if not sh is nothing then
> > > application.Displayalerts = False
> > > sh.Delete
> > > application.DisplayAlerts = True
> > > end if
> > > else
> > > set bk = workbooks.Add()
> > > bk.SaveAs "C:\Myfolder\Destination.xls"
> > > end if
> > > On Error goto 0
> > > thisworkbook.Worksheets("SheetName").copy _
> > > After:=bk.sheets(bk.sheets.count)
> > > bk.Save
> > >
> > > --
> > > Regards,
> > > Tom Ogilvy
> > >
> > >
> > >
> > > "[email protected]" wrote:
> > >
> > > > Help Please with VBA
> > > >
> > > > I would like to copy a worksheet from an active workbook creating a
> new
> > > > workbook if it does not exist. If it exists just to add the worksheet
> > > > to it. Also need it to overwrite a sheet with the same name.
> > > >
> > > > I am using code to save the sheet by cell references and can get as
> far
> > > > as saving to a new workbook, but cannot get to add a sheet, only to
> > > > overwrite the file.
> > > >
> > > > Sounded so simply when i started!! All help greatly appreciated.
> > > >
> > > > Regards and Thanks
> > > >
> > > >
> > > > Peter
> > > >
> > > >
> >