Thread: 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?

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" <zxy55@hotmail.com> wrote in message
news:1115462348.450199.61190@g14g2000cwa.googlegroups.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?
>

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
>

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

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

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" <ec35720@netscapeXSPAM.com> wrote in message
news:427CB473.A06D957E@netscapeXSPAM.com...
> 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

#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" <ec35720@netscapeXSPAM.com> wrote in message
> news:427CB473.A06D957E@netscapeXSPAM.com...
> > 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

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" <ec35720@netscapeXSPAM.com> wrote in message
news:427D028E.EC70BC5D@netscapeXSPAM.com...
> #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" <ec35720@netscapeXSPAM.com> wrote in message
> > news:427CB473.A06D957E@netscapeXSPAM.com...
> > > 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