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
|