Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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? |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
copy sheets
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" wrote in message ups.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? |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
copy sheets
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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
copy sheets
PERFECT!!!!! This i wanted!!!!
Tanks a lot! |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
copy sheets
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 |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
copy cell info to other sheets, other sheets dont contain all row. | Excel Worksheet Functions | |||
move or copy sheets doesn't copy format | Excel Worksheet Functions | |||
copy many sheets into one | Excel Worksheet Functions | |||
in VBA Sheets("mysheet").Copy Befo=Sheets(1) how do i get a reference to the newly created copy of this sheet? | Excel Worksheet Functions | |||
Copy Sheets | Excel Programming |