Thread: copy sheets
View Single Post
  #4   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

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