#1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 4
Default copy sheets

How can i select more worksheets without using
SHEETS(ARRAY("Sheet1","Sheet2")) ?

I have 12 sheets, and 5 of them are named with beginning "C "
and i want to copy all of them in once. How can i?

  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1,120
Default copy sheets


For Each sh In Activeworkbook.Worksheets
If Left(sh.name) = "C" Then
sh.Copy After:=Worksheets(Worsheets.Count)
End If
Next sh

--
HTH

Bob Phillips

"JMG" wrote in message
ups.com...
How can i select more worksheets without using
SHEETS(ARRAY("Sheet1","Sheet2")) ?

I have 12 sheets, and 5 of them are named with beginning "C "
and i want to copy all of them in once. How can i?



  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 4
Default copy sheets

Sorry Bob i forgot to say that i need to copy all in a new workbook.
I'm using now this script.

nSheets = 1
For Each x In Activeworkbook.Worksheets

If Mid (x.name,1,2) = "C " then
If nSheeet = 1 Then
x.Copy
ActiveWorkbook.SaveAs Filename:=fNew
Else
x.Copy After:=Workbooks(fNew).Sheets(nSheets - 1)
End If
nSheets = nSheets +1
End if

next

Any tip?





Bob Phillips ha scritto:
For Each sh In Activeworkbook.Worksheets
If Left(sh.name) = "C" Then
sh.Copy After:=Worksheets(Worsheets.Count)
End If
Next sh


  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1,758
Default copy sheets

Maybe you can build the list of names and just use that:

Option Explicit
Sub testme03()

Dim shtNames() As String
Dim iCtr As Long
Dim sCtr As Long
Dim fNew As String

fNew = "C:\my documents\excel\fnew.xls"

sCtr = 0
For iCtr = 1 To Sheets.Count
If LCase(Left(Sheets(iCtr).Name, 2)) = "c " Then
sCtr = sCtr + 1
ReDim Preserve shtNames(1 To sCtr)
shtNames(sCtr) = Sheets(iCtr).Name
End If
Next iCtr

If sCtr 0 Then
Sheets(shtNames).Copy
ActiveWorkbook.SaveAs Filename:=fNew
Else
MsgBox "No sheets found"
End If

End Sub



JMG wrote:

Sorry Bob i forgot to say that i need to copy all in a new workbook.
I'm using now this script.

nSheets = 1
For Each x In Activeworkbook.Worksheets

If Mid (x.name,1,2) = "C " then
If nSheeet = 1 Then
x.Copy
ActiveWorkbook.SaveAs Filename:=fNew
Else
x.Copy After:=Workbooks(fNew).Sheets(nSheets - 1)
End If
nSheets = nSheets +1
End if

next

Any tip?

Bob Phillips ha scritto:
For Each sh In Activeworkbook.Worksheets
If Left(sh.name) = "C" Then
sh.Copy After:=Worksheets(Worsheets.Count)
End If
Next sh


--

Dave Peterson
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 4
Default copy sheets

PERFECT!!!!! This i wanted!!!!
Tanks a lot!



  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 430
Default copy sheets

Dave,
Do you mind clarifying 3 items within your code?
1) Why the use of LCase() and why did you use "c " ' little c, Not Capital
C?
2) Why use "ReDim Preserve"?
3) Your Line after Sheets(shtnames).copy: Why wouldn't one use
"Workbooks.add",
then SaveAs Filename:=fNew
Thanks in advance,,
Jim

"Dave Peterson" wrote in message
...
Maybe you can build the list of names and just use that:

Option Explicit
Sub testme03()

Dim shtNames() As String
Dim iCtr As Long
Dim sCtr As Long
Dim fNew As String

fNew = "C:\my documents\excel\fnew.xls"

sCtr = 0
For iCtr = 1 To Sheets.Count
If LCase(Left(Sheets(iCtr).Name, 2)) = "c " Then
sCtr = sCtr + 1
ReDim Preserve shtNames(1 To sCtr)
shtNames(sCtr) = Sheets(iCtr).Name
End If
Next iCtr

If sCtr 0 Then
Sheets(shtNames).Copy
ActiveWorkbook.SaveAs Filename:=fNew
Else
MsgBox "No sheets found"
End If

End Sub



JMG wrote:

Sorry Bob i forgot to say that i need to copy all in a new workbook.
I'm using now this script.

nSheets = 1
For Each x In Activeworkbook.Worksheets

If Mid (x.name,1,2) = "C " then
If nSheeet = 1 Then
x.Copy
ActiveWorkbook.SaveAs Filename:=fNew
Else
x.Copy After:=Workbooks(fNew).Sheets(nSheets - 1)
End If
nSheets = nSheets +1
End if

next

Any tip?

Bob Phillips ha scritto:
For Each sh In Activeworkbook.Worksheets
If Left(sh.name) = "C" Then
sh.Copy After:=Worksheets(Worsheets.Count)
End If
Next sh


--

Dave Peterson



  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1,758
Default copy sheets

#1. In excel, I can put "asdf" in A1 and "AsDF" in B1 and "ASDF" in C1 and all
will compare as equal:
=a1=b1, =b1=c1, =a1=c1.

But in VBA, uppercase and lowercase don't match (well, without "Option Compare
Text" at the top of the module).

So if I have worksheets named:
"C xxxx", "c yyyy"
and I want to pick up both sheetnames, I have to compare either both upper case
or both lower case (or use a comparison function that doesn't care about case!).

I went with lcase() = "c ". If I had used lcase() = "C ", it would never have
matched. lCase will always be lower case and "C " ain't!

(Another alternative: if ucase() = "C " would have been fine.)

#2. Each time you redimension an array, each item in that array will be reset
to its default value. In my case, I did this:

dim shtNames() as string

If I removed the Preserve and there were 16 sheets that started with "c ", then
the first 15 would be "" and only the 16th would be correct. Preserves says
don't touch those existing elements in the array. (As long as I'm redimming it
to a larger value.)

If you add shtNames to your watch window, you could step through the code and
watch what happens to that variable. Try it once without the Preserve keyword.

#3. .copy without a destination will copy the sheet/sheets to a new workbook.
So it's built-in.

===
An alternative:

Option Explicit
Sub testme03b()

Dim shtNames() As String
Dim iCtr As Long
Dim sCtr As Long
Dim fNew As String

fNew = "C:\my documents\excel\fnew.xls"

'make it big enough to hold all the sheets
ReDim shtNames(1 To ActiveWorkbook.Sheets.Count)

sCtr = 0
For iCtr = 1 To Sheets.Count
If StrComp(Left(Sheets(iCtr).Name, 2), "c ", vbTextCompare) = 0 Then
sCtr = sCtr + 1
shtNames(sCtr) = Sheets(iCtr).Name
End If
Next iCtr

If sCtr 0 Then
'get rid of the elements that weren't used
ReDim Preserve shtNames(1 To sCtr)
Sheets(shtNames).Copy
ActiveWorkbook.SaveAs Filename:=fNew
Else
MsgBox "No sheets found"
End If

End Sub




Jim May wrote:

Dave,
Do you mind clarifying 3 items within your code?
1) Why the use of LCase() and why did you use "c " ' little c, Not Capital
C?
2) Why use "ReDim Preserve"?
3) Your Line after Sheets(shtnames).copy: Why wouldn't one use
"Workbooks.add",
then SaveAs Filename:=fNew
Thanks in advance,,
Jim

"Dave Peterson" wrote in message
...
Maybe you can build the list of names and just use that:

Option Explicit
Sub testme03()

Dim shtNames() As String
Dim iCtr As Long
Dim sCtr As Long
Dim fNew As String

fNew = "C:\my documents\excel\fnew.xls"

sCtr = 0
For iCtr = 1 To Sheets.Count
If LCase(Left(Sheets(iCtr).Name, 2)) = "c " Then
sCtr = sCtr + 1
ReDim Preserve shtNames(1 To sCtr)
shtNames(sCtr) = Sheets(iCtr).Name
End If
Next iCtr

If sCtr 0 Then
Sheets(shtNames).Copy
ActiveWorkbook.SaveAs Filename:=fNew
Else
MsgBox "No sheets found"
End If

End Sub



JMG wrote:

Sorry Bob i forgot to say that i need to copy all in a new workbook.
I'm using now this script.

nSheets = 1
For Each x In Activeworkbook.Worksheets

If Mid (x.name,1,2) = "C " then
If nSheeet = 1 Then
x.Copy
ActiveWorkbook.SaveAs Filename:=fNew
Else
x.Copy After:=Workbooks(fNew).Sheets(nSheets - 1)
End If
nSheets = nSheets +1
End if

next

Any tip?

Bob Phillips ha scritto:
For Each sh In Activeworkbook.Worksheets
If Left(sh.name) = "C" Then
sh.Copy After:=Worksheets(Worsheets.Count)
End If
Next sh


--

Dave Peterson


--

Dave Peterson
  #8   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 430
Default copy sheets

BRAVO Dave!!
I salute you! << for this and all of your other responses 'which I try to
read and digest.
your kindness is much appreciated.
Jim May

"Dave Peterson" wrote in message
...
#1. In excel, I can put "asdf" in A1 and "AsDF" in B1 and "ASDF" in C1

and all
will compare as equal:
=a1=b1, =b1=c1, =a1=c1.

But in VBA, uppercase and lowercase don't match (well, without "Option

Compare
Text" at the top of the module).

So if I have worksheets named:
"C xxxx", "c yyyy"
and I want to pick up both sheetnames, I have to compare either both upper

case
or both lower case (or use a comparison function that doesn't care about

case!).

I went with lcase() = "c ". If I had used lcase() = "C ", it would never

have
matched. lCase will always be lower case and "C " ain't!

(Another alternative: if ucase() = "C " would have been fine.)

#2. Each time you redimension an array, each item in that array will be

reset
to its default value. In my case, I did this:

dim shtNames() as string

If I removed the Preserve and there were 16 sheets that started with "c ",

then
the first 15 would be "" and only the 16th would be correct. Preserves

says
don't touch those existing elements in the array. (As long as I'm

redimming it
to a larger value.)

If you add shtNames to your watch window, you could step through the code

and
watch what happens to that variable. Try it once without the Preserve

keyword.

#3. .copy without a destination will copy the sheet/sheets to a new

workbook.
So it's built-in.

===
An alternative:

Option Explicit
Sub testme03b()

Dim shtNames() As String
Dim iCtr As Long
Dim sCtr As Long
Dim fNew As String

fNew = "C:\my documents\excel\fnew.xls"

'make it big enough to hold all the sheets
ReDim shtNames(1 To ActiveWorkbook.Sheets.Count)

sCtr = 0
For iCtr = 1 To Sheets.Count
If StrComp(Left(Sheets(iCtr).Name, 2), "c ", vbTextCompare) = 0

Then
sCtr = sCtr + 1
shtNames(sCtr) = Sheets(iCtr).Name
End If
Next iCtr

If sCtr 0 Then
'get rid of the elements that weren't used
ReDim Preserve shtNames(1 To sCtr)
Sheets(shtNames).Copy
ActiveWorkbook.SaveAs Filename:=fNew
Else
MsgBox "No sheets found"
End If

End Sub




Jim May wrote:

Dave,
Do you mind clarifying 3 items within your code?
1) Why the use of LCase() and why did you use "c " ' little c, Not

Capital
C?
2) Why use "ReDim Preserve"?
3) Your Line after Sheets(shtnames).copy: Why wouldn't one use
"Workbooks.add",
then SaveAs Filename:=fNew
Thanks in advance,,
Jim

"Dave Peterson" wrote in message
...
Maybe you can build the list of names and just use that:

Option Explicit
Sub testme03()

Dim shtNames() As String
Dim iCtr As Long
Dim sCtr As Long
Dim fNew As String

fNew = "C:\my documents\excel\fnew.xls"

sCtr = 0
For iCtr = 1 To Sheets.Count
If LCase(Left(Sheets(iCtr).Name, 2)) = "c " Then
sCtr = sCtr + 1
ReDim Preserve shtNames(1 To sCtr)
shtNames(sCtr) = Sheets(iCtr).Name
End If
Next iCtr

If sCtr 0 Then
Sheets(shtNames).Copy
ActiveWorkbook.SaveAs Filename:=fNew
Else
MsgBox "No sheets found"
End If

End Sub



JMG wrote:

Sorry Bob i forgot to say that i need to copy all in a new workbook.
I'm using now this script.

nSheets = 1
For Each x In Activeworkbook.Worksheets

If Mid (x.name,1,2) = "C " then
If nSheeet = 1 Then
x.Copy
ActiveWorkbook.SaveAs Filename:=fNew
Else
x.Copy After:=Workbooks(fNew).Sheets(nSheets - 1)
End If
nSheets = nSheets +1
End if

next

Any tip?

Bob Phillips ha scritto:
For Each sh In Activeworkbook.Worksheets
If Left(sh.name) = "C" Then
sh.Copy After:=Worksheets(Worsheets.Count)
End If
Next sh


--

Dave Peterson


--

Dave Peterson



Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
copy cell info to other sheets, other sheets dont contain all row. Ja Excel Worksheet Functions 1 November 1st 09 12:53 AM
move or copy sheets doesn't copy format ColinX Excel Worksheet Functions 1 May 14th 08 10:07 PM
copy many sheets into one Annie_Ioceva Excel Worksheet Functions 1 January 9th 08 04:14 PM
in VBA Sheets("mysheet").Copy Befo=Sheets(1) how do i get a reference to the newly created copy of this sheet? Daniel Excel Worksheet Functions 1 July 6th 05 09:57 PM
Copy Sheets Edgar Excel Programming 1 April 27th 04 03:22 PM


All times are GMT +1. The time now is 06:12 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"