Desktop Folder To Workbook
 

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

Desktop Folder To Workbook
 

On Fri, 13 Feb 2009 06:21:02 -0800, Sue
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

Desktop Folder To Workbook
 

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
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

Desktop Folder To Workbook
 

On Sun, 15 Feb 2009 13:23:02 -0800, Sue
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

Desktop Folder To Workbook
 

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
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

Desktop Folder To Workbook
 

On Mon, 16 Feb 2009 01:37:01 -0800, Sue
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
--
Dick Kusleika
Microsoft MVP-Excel
http://www.dailydoseofexcel.com

Desktop Folder To Workbook
 

On Mon, 16 Feb 2009 11:06:27 -0600, Dick Kusleika
wrote:

On Mon, 16 Feb 2009 01:37:01 -0800, Sue
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

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

Desktop Folder To Workbook
 

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

On Mon, 16 Feb 2009 01:37:01 -0800, Sue
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

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

Desktop Folder To Workbook
 

On Tue, 17 Feb 2009 11:49:27 -0800, Sue
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

Desktop Folder To Workbook
 

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
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

Desktop Folder To Workbook
 

On Thu, 19 Feb 2009 03:10:00 -0800, Sue
wrote:

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.

Make sure you change sPATH to point to the right folder on your Desktop. I
meant to change it before I posted but I must have forgot.
--
Dick Kusleika
Microsoft MVP-Excel
http://www.dailydoseofexcel.com

Desktop Folder To Workbook
 

Hi

I noticed that before I posted and changed the path to the correct folder on
the desk top.

I apologise for being such a pain in the you know what - however your help
is very much appreciated.
--
Many Thanks

Sue


"Dick Kusleika" wrote:

On Thu, 19 Feb 2009 03:10:00 -0800, Sue
wrote:

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.

Make sure you change sPATH to point to the right folder on your Desktop. I
meant to change it before I posted but I must have forgot.
--
Dick Kusleika
Microsoft MVP-Excel
http://www.dailydoseofexcel.com

Desktop Folder To Workbook
 

On Thu, 19 Feb 2009 07:45:04 -0800, Sue
wrote:

Hi

I noticed that before I posted and changed the path to the correct folder on
the desk top.

I apologise for being such a pain in the you know what - however your help
is very much appreciated.

No problem Sue. We're missing something simple, we just need to figure out
what it is. So it's not even copying the files. This next test is a bit
dangerous, so save any open files and close them before running 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 & "*.*")

Do While Len(sFname) 0
Debug.Print sFname
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

This one will open every file in that folder, even non-Excel ones. Tell me
what you get - results or errors.
--
Dick Kusleika
Microsoft MVP-Excel
http://www.dailydoseofexcel.com

Desktop Folder To Workbook
 

Hi

I did exactly as you told me in your latest post -- changed the path to the
correct one and had the same result New workbook opened but nothing from the
desktop folder CARD


--
Many Thanks

Sue


"Dick Kusleika" wrote:

On Thu, 19 Feb 2009 07:45:04 -0800, Sue
wrote:

Hi

I noticed that before I posted and changed the path to the correct folder on
the desk top.

I apologise for being such a pain in the you know what - however your help
is very much appreciated.

No problem Sue. We're missing something simple, we just need to figure out
what it is. So it's not even copying the files. This next test is a bit
dangerous, so save any open files and close them before running 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 & "*.*")

Do While Len(sFname) 0
Debug.Print sFname
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

This one will open every file in that folder, even non-Excel ones. Tell me
what you get - results or errors.
--
Dick Kusleika
Microsoft MVP-Excel
http://www.dailydoseofexcel.com

Desktop Folder To Workbook
 

Hi

I forgot to mention there were no error messages
--
Many Thanks

Sue


"Dick Kusleika" wrote:

On Thu, 19 Feb 2009 07:45:04 -0800, Sue
wrote:

Hi

I noticed that before I posted and changed the path to the correct folder on
the desk top.

I apologise for being such a pain in the you know what - however your help
is very much appreciated.

No problem Sue. We're missing something simple, we just need to figure out
what it is. So it's not even copying the files. This next test is a bit
dangerous, so save any open files and close them before running 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 & "*.*")

Do While Len(sFname) 0
Debug.Print sFname
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

This one will open every file in that folder, even non-Excel ones. Tell me
what you get - results or errors.
--
Dick Kusleika
Microsoft MVP-Excel
http://www.dailydoseofexcel.com

Desktop Folder To Workbook
 

On Fri, 20 Feb 2009 06:17:02 -0800, Sue
wrote:

Hi

I forgot to mention there were no error messages

Sue: Open the VBE (Alt+F11) and the Immediate Window (Control+G). Run the
code again and see if anything shows up in the Immediate Window.
--
Dick Kusleika
Microsoft MVP-Excel
http://www.dailydoseofexcel.com

Desktop Folder To Workbook
 

Hi

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 & "*.*")

Do While Len(sFname) 0
Debug.Print sFname
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

Immediate Window -- Displays OB1.xls
--
Many Thanks

Sue


"Dick Kusleika" wrote:

On Fri, 20 Feb 2009 06:17:02 -0800, Sue
wrote:

Hi

I forgot to mention there were no error messages

Sue: Open the VBE (Alt+F11) and the Immediate Window (Control+G). Run the
code again and see if anything shows up in the Immediate Window.
--
Dick Kusleika
Microsoft MVP-Excel
http://www.dailydoseofexcel.com

Desktop Folder To Workbook
 

On Fri, 20 Feb 2009 12:37:01 -0800, Sue
wrote:


Immediate Window -- Displays OB1.xls

Run 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\Sue\Desktop\CARD\"

Set wbDest = Workbooks.Add

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

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

End Sub

and tell me what the Immediate Window says.
--
Dick

Desktop Folder To Workbook
 

Hi
Error Message on Set wbSource line see below!!!

Sub MakeSueA()

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 & "*.*")

Do While Len(sFname) 0
Debug.Print sFname
Set wbSource = Workbooks.Open(sFname) '<<<<<<Message Box: Run-Time 1004 -
OB1.xls could not be found
Debug.Print wbSource.Name
wbSource.Sheets(1).Copy , wbDest.Sheets(wbDest.Sheets.Count)
Debug.Print "Count: " & wbDest.Sheets.Count
wbDest.Sheets(wbDest.Sheets.Count).Name = Replace(wbSource.Name, ".xls", "")
wbSource.Close False
sFname = Dir
Loop

End Sub

As before Immediate Window -- Displays OB1.xls

--
Many Thanks

Sue


"Dick Kusleika" wrote:

On Fri, 20 Feb 2009 12:37:01 -0800, Sue
wrote:


Immediate Window -- Displays OB1.xls

Run 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\Sue\Desktop\CARD\"

Set wbDest = Workbooks.Add

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

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

End Sub

and tell me what the Immediate Window says.
--
Dick

Desktop Folder To Workbook
 

The sfname variable only contains the filename--it doesn't include the path.

Set wbSource = Workbooks.Open(sFname)
should be:
Set wbSource = Workbooks.Open(spath & sFname)

Sue wrote:

Hi
Error Message on Set wbSource line see below!!!

Sub MakeSueA()

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 & "*.*")

Do While Len(sFname) 0
Debug.Print sFname
Set wbSource = Workbooks.Open(sFname) '<<<<<<Message Box: Run-Time 1004 -
OB1.xls could not be found
Debug.Print wbSource.Name
wbSource.Sheets(1).Copy , wbDest.Sheets(wbDest.Sheets.Count)
Debug.Print "Count: " & wbDest.Sheets.Count
wbDest.Sheets(wbDest.Sheets.Count).Name = Replace(wbSource.Name, ".xls", "")
wbSource.Close False
sFname = Dir
Loop

End Sub

As before Immediate Window -- Displays OB1.xls

--
Many Thanks

Sue

"Dick Kusleika" wrote:

On Fri, 20 Feb 2009 12:37:01 -0800, Sue
wrote:


Immediate Window -- Displays OB1.xls

Run 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\Sue\Desktop\CARD\"

Set wbDest = Workbooks.Add

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

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

End Sub

and tell me what the Immediate Window says.
--
Dick


--

Dave Peterson

Desktop Folder To Workbook
 

Hi

Just to say many thanks to all now working exactly
as required.
--
Many Thanks

Sue


"Dave Peterson" wrote:

The sfname variable only contains the filename--it doesn't include the path.

Set wbSource = Workbooks.Open(sFname)
should be:
Set wbSource = Workbooks.Open(spath & sFname)

Sue wrote:

Hi
Error Message on Set wbSource line see below!!!

Sub MakeSueA()

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 & "*.*")

Do While Len(sFname) 0
Debug.Print sFname
Set wbSource = Workbooks.Open(sFname) '<<<<<<Message Box: Run-Time 1004 -
OB1.xls could not be found
Debug.Print wbSource.Name
wbSource.Sheets(1).Copy , wbDest.Sheets(wbDest.Sheets.Count)
Debug.Print "Count: " & wbDest.Sheets.Count
wbDest.Sheets(wbDest.Sheets.Count).Name = Replace(wbSource.Name, ".xls", "")
wbSource.Close False
sFname = Dir
Loop

End Sub

As before Immediate Window -- Displays OB1.xls

--
Many Thanks

Sue

"Dick Kusleika" wrote:

On Fri, 20 Feb 2009 12:37:01 -0800, Sue
wrote:


Immediate Window -- Displays OB1.xls

Run 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\Sue\Desktop\CARD\"

Set wbDest = Workbooks.Add

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

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

End Sub

and tell me what the Immediate Window says.
--
Dick


--

Dave Peterson