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
|