Thread: copy sheets
View Single Post
  #7   Report Post  
Posted to microsoft.public.excel.programming
Dave Peterson[_5_] Dave Peterson[_5_] is offline
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