Hi
I have a folder on the desktop named CARD within the folder there are 20
single sheets all with a different name e.g. OB1, OB2, OB3 etc is it possible
in VBA to copy all the named sheets into a new workbook named 'Sue' in the
correct order of the sheet tab Ob1, OB2, OB3 etc and at the same time delete
sheets 1 to 4 that open in the new workbook 'Sue' I could then assign the
macro to a CommandButton.
--
Many Thanks

Sue

On Fri, 13 Feb 2009 06:21:02 -0800, Sue <(E-Mail Removed)>
wrote:

>Hi
>I have a folder on the desktop named CARD within the folder there are 20
>single sheets all with a different name e.g. OB1, OB2, OB3 etc is it possible
>in VBA to copy all the named sheets into a new workbook named 'Sue' in the
>correct order of the sheet tab Ob1, OB2, OB3 etc and at the same time delete
>sheets 1 to 4 that open in the new workbook 'Sue' I could then assign the
>macro to a CommandButton.

Sub MakeSue()

Dim wbDest As Workbook
Dim wbSource As Workbook
Dim sh As Worksheet
Dim sFname As String

Const sPATH = "C:\Documents and Settings\Dick\Desktop\CARD\"

Set wbDest = Workbooks.Add

sFname = Dir(sPATH & "OB*.xls")

Do While Len(sFname) > 0
Set wbSource = Workbooks.Open(sFname)
wbSource.Sheets(1).Copy , wbDest.Sheets(wbDest.Sheets.Count)
wbDest.Sheets(wbDest.Sheets.Count).Name = Replace(wbSource.Name,
".xls", "")
wbSource.Close False
sFname = Dir
Loop

Application.DisplayAlerts = False
For Each sh In wbDest.Worksheets
If Not sh.Name Like "OB*" Then
sh.Delete
End If
Next sh
Application.DisplayAlerts = True

End Sub

Change the path to point to your desktop

--
Dick Kusleika
Microsoft MVP-Excel
http://www.dailydoseofexcel.com

Hi
Thanks for the help -- however getting an error 1004
A workbook must contain at least one visible worksheet
Have indicated below where it kicks in
I have in the folder CARD sheets OB1,OB2,OB3 etc but they are
not going into the added workbook any help much appreciated

Sub MakeSue()
Dim wbDest As Workbook
Dim wbSource As Workbook
Dim sh As Worksheet
Dim sFname As String

Const sPATH = "C:\Documents And Settings\Sue\Desktop\CARD\ "

Set wbDest = Workbooks.Add

sFname = Dir(sPATH & "OB*.xls")

Do While Len(sFname) > 0
Set wbSource = Workbooks.Open(sFname)
wbSource.Sheets(1).Copy , wbDest.Sheets(wbDest.Sheets.Count)
wbDest.Sheets(wbDest.Sheets.Count).Name = Replace(wbSource.Name, ".xls", "")
wbSource.Close False
sFname = Dir
Loop

Application.DisplayAlerts = False
For Each sh In wbDest.Worksheets
If Not sh.Name Like "OB*" Then
sh.Delete ' <<<<< it debugs at this line
End If
Next sh
Application.DisplayAlerts = True

End Sub

--
Many Thanks

Sue


"Dick Kusleika" wrote:

> On Fri, 13 Feb 2009 06:21:02 -0800, Sue <(E-Mail Removed)>
> wrote:
>
> >Hi
> >I have a folder on the desktop named CARD within the folder there are 20
> >single sheets all with a different name e.g. OB1, OB2, OB3 etc is it possible
> >in VBA to copy all the named sheets into a new workbook named 'Sue' in the
> >correct order of the sheet tab Ob1, OB2, OB3 etc and at the same time delete
> >sheets 1 to 4 that open in the new workbook 'Sue' I could then assign the
> >macro to a CommandButton.
>
> Sub MakeSue()
>
> Dim wbDest As Workbook
> Dim wbSource As Workbook
> Dim sh As Worksheet
> Dim sFname As String
>
> Const sPATH = "C:\Documents and Settings\Dick\Desktop\CARD\"
>
> Set wbDest = Workbooks.Add
>
> sFname = Dir(sPATH & "OB*.xls")
>
> Do While Len(sFname) > 0
> Set wbSource = Workbooks.Open(sFname)
> wbSource.Sheets(1).Copy , wbDest.Sheets(wbDest.Sheets.Count)
> wbDest.Sheets(wbDest.Sheets.Count).Name = Replace(wbSource.Name,
> ".xls", "")
> wbSource.Close False
> sFname = Dir
> Loop
>
> Application.DisplayAlerts = False
> For Each sh In wbDest.Worksheets
> If Not sh.Name Like "OB*" Then
> sh.Delete
> End If
> Next sh
> Application.DisplayAlerts = True
>
> End Sub
>
> Change the path to point to your desktop
>
> --
> Dick Kusleika
> Microsoft MVP-Excel
> http://www.dailydoseofexcel.com
>

On Sun, 15 Feb 2009 13:23:02 -0800, Sue <(E-Mail Removed)>
wrote:

>Hi
>Thanks for the help -- however getting an error 1004
>A workbook must contain at least one visible worksheet
>Have indicated below where it kicks in
>I have in the folder CARD sheets OB1,OB2,OB3 etc but they are
>not going into the added workbook any help much appreciated

You say you have sheets in a folder. Are they Excel workbooks? Are the
worksheets inside of a workbook? Do they have a file extension (like .xls)?
--
Dick Kusleika
Microsoft MVP-Excel
http://www.dailydoseofexcel.com

Hi

They are separate worksheets in a folder and just checked the properties and
all
have the extension .xls
--
Many Thanks

Sue


"Dick Kusleika" wrote:

> On Sun, 15 Feb 2009 13:23:02 -0800, Sue <(E-Mail Removed)>
> wrote:
>
> >Hi
> >Thanks for the help -- however getting an error 1004
> >A workbook must contain at least one visible worksheet
> >Have indicated below where it kicks in
> >I have in the folder CARD sheets OB1,OB2,OB3 etc but they are
> >not going into the added workbook any help much appreciated
>
> You say you have sheets in a folder. Are they Excel workbooks? Are the
> worksheets inside of a workbook? Do they have a file extension (like .xls)?
> --
> Dick Kusleika
> Microsoft MVP-Excel
> http://www.dailydoseofexcel.com
>

On Mon, 16 Feb 2009 01:37:01 -0800, Sue <(E-Mail Removed)>
wrote:

>Hi
>
>They are separate worksheets in a folder and just checked the properties and
>all
>have the extension .xls

I just want to be clear on this, I'm not trying to be pedantic. Worksheets
go in Workbooks. Workbooks go in Folders. Do you have a bunch of Workbooks
in the folder that have a single Worksheet in them? Are they named like

OB1.xls
OB2.xls
OB3.xls

The code looks for all the files like OB*.xls where the asterisk can be any
number of letter, but appearently the code isn't finding any files. So
we're missing something on where the files are located or how they are
named. If you want to take a screen grab of the folder (including the
address bar) you can feel free to send it to (E-Mail Removed)
--
Dick Kusleika
Microsoft MVP-Excel
http://www.dailydoseofexcel.com

On Mon, 16 Feb 2009 11:06:27 -0600, Dick Kusleika <(E-Mail Removed)>
wrote:

>On Mon, 16 Feb 2009 01:37:01 -0800, Sue <(E-Mail Removed)>
>wrote:
>
>>Hi
>>
>>They are separate worksheets in a folder and just checked the properties and
>>all
>>have the extension .xls
>
>I just want to be clear on this, I'm not trying to be pedantic. Worksheets
>go in Workbooks. Workbooks go in Folders. Do you have a bunch of Workbooks
>in the folder that have a single Worksheet in them? Are they named like
>
>OB1.xls
>OB2.xls
>OB3.xls
>
>The code looks for all the files like OB*.xls where the asterisk can be any
>number of letter, but appearently the code isn't finding any files. So
>we're missing something on where the files are located or how they are
>named. If you want to take a screen grab of the folder (including the
>address bar) you can feel free to send it to (E-Mail Removed)

Thanks Sue. Yes, it looks like it your folder is set up just like you said
(and just like mine). For some reason the code isn't picking up those
files, I can't tell why. Try running this code

Sub testext()

Dim sFname As String

sFname = Dir("C:\Documents and Settings\Sue\Desktop\CARD\OB*.xls")

MsgBox sFname & vbNewLine & "Length: " & Len(sFname)


End Sub

and see what you get in the message box. If you get "Length: 0", then try
running this code

Sub testext()

Dim sFname As String

sFname = Dir("C:\Documents and Settings\Sue\Desktop\CARD\*.*")

MsgBox sFname & vbNewLine & "Length: " & Len(sFname)


End Sub

And tell me what you get.

--
Dick Kusleika
Microsoft MVP-Excel
http://www.dailydoseofexcel.com

Hi

Our company internet been on the blink all day only just got your message

Tried both the Sub testext() get the same message each time

OB1.xls
Length:7

Hope this helps I'm hopelessly lost

--
Many Thanks

Sue


"Dick Kusleika" wrote:

> On Mon, 16 Feb 2009 11:06:27 -0600, Dick Kusleika <(E-Mail Removed)>
> wrote:
>
> >On Mon, 16 Feb 2009 01:37:01 -0800, Sue <(E-Mail Removed)>
> >wrote:
> >
> >>Hi
> >>
> >>They are separate worksheets in a folder and just checked the properties and
> >>all
> >>have the extension .xls
> >
> >I just want to be clear on this, I'm not trying to be pedantic. Worksheets
> >go in Workbooks. Workbooks go in Folders. Do you have a bunch of Workbooks
> >in the folder that have a single Worksheet in them? Are they named like
> >
> >OB1.xls
> >OB2.xls
> >OB3.xls
> >
> >The code looks for all the files like OB*.xls where the asterisk can be any
> >number of letter, but appearently the code isn't finding any files. So
> >we're missing something on where the files are located or how they are
> >named. If you want to take a screen grab of the folder (including the
> >address bar) you can feel free to send it to (E-Mail Removed)
>
> Thanks Sue. Yes, it looks like it your folder is set up just like you said
> (and just like mine). For some reason the code isn't picking up those
> files, I can't tell why. Try running this code
>
> Sub testext()
>
> Dim sFname As String
>
> sFname = Dir("C:\Documents and Settings\Sue\Desktop\CARD\OB*.xls")
>
> MsgBox sFname & vbNewLine & "Length: " & Len(sFname)
>
>
> End Sub
>
> and see what you get in the message box. If you get "Length: 0", then try
> running this code
>
> Sub testext()
>
> Dim sFname As String
>
> sFname = Dir("C:\Documents and Settings\Sue\Desktop\CARD\*.*")
>
> MsgBox sFname & vbNewLine & "Length: " & Len(sFname)
>
>
> End Sub
>
> And tell me what you get.
>
> --
> Dick Kusleika
> Microsoft MVP-Excel
> http://www.dailydoseofexcel.com
>

On Tue, 17 Feb 2009 11:49:27 -0800, Sue <(E-Mail Removed)>
wrote:

>Hi
>
>Our company internet been on the blink all day only just got your message
>
>Tried both the Sub testext() get the same message each time
>
>OB1.xls
>Length:7
>
>Hope this helps I'm hopelessly lost

Sue: Let's try this:

Sub MakeSue()

Dim wbDest As Workbook
Dim wbSource As Workbook
Dim sh As Worksheet
Dim sFname As String

Const sPATH = "C:\Documents and Settings\Dick\Desktop\CARD\"

Set wbDest = Workbooks.Add

sFname = Dir(sPATH & "OB*.xls")

Do While Len(sFname) > 0
Set wbSource = Workbooks.Open(sFname)
wbSource.Sheets(1).Copy , wbDest.Sheets(wbDest.Sheets.Count)
wbDest.Sheets(wbDest.Sheets.Count).Name = Replace(wbSource.Name,
".xls", "")
wbSource.Close False
sFname = Dir
Loop

End Sub

You should end up with a workbook with all of the sheets copied into plus
all of the sheets that were originally in the workbook. I was thinking the
sheets weren't getting copied in, now I'm thinking they are getting copied
in but are being deleted later.]

Let me know what sheets are in the workbook when you run the above code.
--
Dick Kusleika
Microsoft MVP-Excel
http://www.dailydoseofexcel.com

Hi

What is happening now is a new workbook is opening "Book1" with sheets 1 to
4 all blank and nothing else within the Workbook all my new workbooks default
to 4 sheets. So it looks as if the code is not copying the sheets in the
folder CARD.
--
Many Thanks

Sue


"Dick Kusleika" wrote:

> On Tue, 17 Feb 2009 11:49:27 -0800, Sue <(E-Mail Removed)>
> wrote:
>
> >Hi
> >
> >Our company internet been on the blink all day only just got your message
> >
> >Tried both the Sub testext() get the same message each time
> >
> >OB1.xls
> >Length:7
> >
> >Hope this helps I'm hopelessly lost
>
> Sue: Let's try this:
>
> Sub MakeSue()
>
> Dim wbDest As Workbook
> Dim wbSource As Workbook
> Dim sh As Worksheet
> Dim sFname As String
>
> Const sPATH = "C:\Documents and Settings\Dick\Desktop\CARD\"
>
> Set wbDest = Workbooks.Add
>
> sFname = Dir(sPATH & "OB*.xls")
>
> Do While Len(sFname) > 0
> Set wbSource = Workbooks.Open(sFname)
> wbSource.Sheets(1).Copy , wbDest.Sheets(wbDest.Sheets.Count)
> wbDest.Sheets(wbDest.Sheets.Count).Name = Replace(wbSource.Name,
> ".xls", "")
> wbSource.Close False
> sFname = Dir
> Loop
>
> End Sub
>
> You should end up with a workbook with all of the sheets copied into plus
> all of the sheets that were originally in the workbook. I was thinking the
> sheets weren't getting copied in, now I'm thinking they are getting copied
> in but are being deleted later.]
>
> Let me know what sheets are in the workbook when you run the above code.
> --
> Dick Kusleika
> Microsoft MVP-Excel
> http://www.dailydoseofexcel.com
>