Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
I want to insert a certain number of row texts into 20 identical spreadsheets.
When I copy the area I want to insert then my macro stops after the first of the 20 sheets. I use "for x=1 to 20" "Next x" to acheive the repeated copy. Is there a simple way to get the result i want? 20 sheets in one Workbook The code I have is the following. It solves the problem but on slow machines in the organisation it takes time as I make three loops ----------------------------------------------------------- ActiveSheet.Unprotect Password:="tomstr" Sheets("Pos A").Select For x = 1 To 20 ActiveSheet.Unprotect Password:="tomstr" Range("a31").Select ActiveSheet.Next.Select Next x Sheets("Parametrar").Select Range("b40:e77").Select Application.CutCopyMode = False Selection.Copy Sheets("Pos A").Select For x = 1 To 20 ActiveSheet.Paste ActiveSheet.Next.Select Next x Sheets("Pos A").Select For x = 1 To 20 Range("a12").Select Range("a2").Select Range("a1").Select ActiveSheet.Protect Password:="tomstr" ActiveSheet.Next.Select Next x Sheets("Projektbeskrivning").Select ActiveSheet.Protect Password:="tomstr" Range("a12").Select Range("a2").Select Range("a1").Select End Sub -- Tomas S |
#2
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
Does this work for you?
Sheets("Parametrar").Range("b40:e77").Copy ActiveSheet.Unprotect Password:="tomstr" For Each sh In ActiveWorkbook.Worksheets If sh.Name < "Parametrar" Then sh.Unprotect Password:="tomstr" Sheets("Parametrar").Range("b40:e77").Copy _ sh.Range("A1") sh.Protect Password:="tomstr" End If Next x ActiveSheet.Protect Password:="tomstr" -- HTH Bob Phillips (remove nothere from email address if mailing direct) "Tomas Stroem" wrote in message ... I want to insert a certain number of row texts into 20 identical spreadsheets. When I copy the area I want to insert then my macro stops after the first of the 20 sheets. I use "for x=1 to 20" "Next x" to acheive the repeated copy. Is there a simple way to get the result i want? 20 sheets in one Workbook The code I have is the following. It solves the problem but on slow machines in the organisation it takes time as I make three loops ----------------------------------------------------------- ActiveSheet.Unprotect Password:="tomstr" Sheets("Pos A").Select For x = 1 To 20 ActiveSheet.Unprotect Password:="tomstr" Range("a31").Select ActiveSheet.Next.Select Next x Sheets("Parametrar").Select Range("b40:e77").Select Application.CutCopyMode = False Selection.Copy Sheets("Pos A").Select For x = 1 To 20 ActiveSheet.Paste ActiveSheet.Next.Select Next x Sheets("Pos A").Select For x = 1 To 20 Range("a12").Select Range("a2").Select Range("a1").Select ActiveSheet.Protect Password:="tomstr" ActiveSheet.Next.Select Next x Sheets("Projektbeskrivning").Select ActiveSheet.Protect Password:="tomstr" Range("a12").Select Range("a2").Select Range("a1").Select End Sub -- Tomas S |
#3
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
Thanks Bob,
Excellent help ! This made it much better, but there is still one thing that this did not solve. There are more than the 20 Identical sheets in the file that contain different calculations. I have achieved to avoid the texts being copied to all but one of the sheets. I get a run-time error '1004' warning that "Cannot change part of a merged cell" and then the following code is highlighted Sheets("Parametrar").Range("b40:e77").Copy _ sh.Range("A31") The mission is completed correctly but I dont want the error message to appear. ------ The full code I use is inserted below Sheets("Parametrar").Select ActiveSheet.Unprotect Password:="tomstr" Sheets("Parametrar").Range("b40:e77").Copy ActiveSheet.Unprotect Password:="tomstr" For Each sh In ActiveWorkbook.Worksheets If sh.Name < "Parametrar" And sh.Name < "Projektbeskrivning" And sh.Name < "Fritexter" And sh.Name < "Kassaflöde" And sh.Name < "Provision & Bank" And sh.Name < "Valutakurser" And sh.Name < "Aktiva" And sh.Name < "Sammanställning" And sh.Name < "Valuta & Betalningsplan" Then sh.Unprotect Password:="tomstr" Sheets("Parametrar").Range("b40:e77").Copy _ sh.Range("A31") sh.Protect Password:="tomstr" End If Next ActiveSheet.Protect Password:="tomstr" Sheets("Projektbeskrivning").Select ActiveSheet.Protect Password:="tomstr" Range("a12").Select Range("a2").Select Range("a1").Select End Sub -- Tomas S "Bob Phillips" skrev: Does this work for you? Sheets("Parametrar").Range("b40:e77").Copy ActiveSheet.Unprotect Password:="tomstr" For Each sh In ActiveWorkbook.Worksheets If sh.Name < "Parametrar" Then sh.Unprotect Password:="tomstr" Sheets("Parametrar").Range("b40:e77").Copy _ sh.Range("A1") sh.Protect Password:="tomstr" End If Next x ActiveSheet.Protect Password:="tomstr" -- HTH Bob Phillips (remove nothere from email address if mailing direct) "Tomas Stroem" wrote in message ... I want to insert a certain number of row texts into 20 identical spreadsheets. When I copy the area I want to insert then my macro stops after the first of the 20 sheets. I use "for x=1 to 20" "Next x" to acheive the repeated copy. Is there a simple way to get the result i want? 20 sheets in one Workbook The code I have is the following. It solves the problem but on slow machines in the organisation it takes time as I make three loops ----------------------------------------------------------- ActiveSheet.Unprotect Password:="tomstr" Sheets("Pos A").Select For x = 1 To 20 ActiveSheet.Unprotect Password:="tomstr" Range("a31").Select ActiveSheet.Next.Select Next x Sheets("Parametrar").Select Range("b40:e77").Select Application.CutCopyMode = False Selection.Copy Sheets("Pos A").Select For x = 1 To 20 ActiveSheet.Paste ActiveSheet.Next.Select Next x Sheets("Pos A").Select For x = 1 To 20 Range("a12").Select Range("a2").Select Range("a1").Select ActiveSheet.Protect Password:="tomstr" ActiveSheet.Next.Select Next x Sheets("Projektbeskrivning").Select ActiveSheet.Protect Password:="tomstr" Range("a12").Select Range("a2").Select Range("a1").Select End Sub -- Tomas S |
#4
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
Get rid of the merged cells, they are more trouble than they are worth.
-- HTH Bob Phillips (remove nothere from email address if mailing direct) "Tomas Stroem" wrote in message ... Thanks Bob, Excellent help ! This made it much better, but there is still one thing that this did not solve. There are more than the 20 Identical sheets in the file that contain different calculations. I have achieved to avoid the texts being copied to all but one of the sheets. I get a run-time error '1004' warning that "Cannot change part of a merged cell" and then the following code is highlighted Sheets("Parametrar").Range("b40:e77").Copy _ sh.Range("A31") The mission is completed correctly but I dont want the error message to appear. ------ The full code I use is inserted below Sheets("Parametrar").Select ActiveSheet.Unprotect Password:="tomstr" Sheets("Parametrar").Range("b40:e77").Copy ActiveSheet.Unprotect Password:="tomstr" For Each sh In ActiveWorkbook.Worksheets If sh.Name < "Parametrar" And sh.Name < "Projektbeskrivning" And sh.Name < "Fritexter" And sh.Name < "Kassaflöde" And sh.Name < "Provision & Bank" And sh.Name < "Valutakurser" And sh.Name < "Aktiva" And sh.Name < "Sammanställning" And sh.Name < "Valuta & Betalningsplan" Then sh.Unprotect Password:="tomstr" Sheets("Parametrar").Range("b40:e77").Copy _ sh.Range("A31") sh.Protect Password:="tomstr" End If Next ActiveSheet.Protect Password:="tomstr" Sheets("Projektbeskrivning").Select ActiveSheet.Protect Password:="tomstr" Range("a12").Select Range("a2").Select Range("a1").Select End Sub -- Tomas S "Bob Phillips" skrev: Does this work for you? Sheets("Parametrar").Range("b40:e77").Copy ActiveSheet.Unprotect Password:="tomstr" For Each sh In ActiveWorkbook.Worksheets If sh.Name < "Parametrar" Then sh.Unprotect Password:="tomstr" Sheets("Parametrar").Range("b40:e77").Copy _ sh.Range("A1") sh.Protect Password:="tomstr" End If Next x ActiveSheet.Protect Password:="tomstr" -- HTH Bob Phillips (remove nothere from email address if mailing direct) "Tomas Stroem" wrote in message ... I want to insert a certain number of row texts into 20 identical spreadsheets. When I copy the area I want to insert then my macro stops after the first of the 20 sheets. I use "for x=1 to 20" "Next x" to acheive the repeated copy. Is there a simple way to get the result i want? 20 sheets in one Workbook The code I have is the following. It solves the problem but on slow machines in the organisation it takes time as I make three loops ----------------------------------------------------------- ActiveSheet.Unprotect Password:="tomstr" Sheets("Pos A").Select For x = 1 To 20 ActiveSheet.Unprotect Password:="tomstr" Range("a31").Select ActiveSheet.Next.Select Next x Sheets("Parametrar").Select Range("b40:e77").Select Application.CutCopyMode = False Selection.Copy Sheets("Pos A").Select For x = 1 To 20 ActiveSheet.Paste ActiveSheet.Next.Select Next x Sheets("Pos A").Select For x = 1 To 20 Range("a12").Select Range("a2").Select Range("a1").Select ActiveSheet.Protect Password:="tomstr" ActiveSheet.Next.Select Next x Sheets("Projektbeskrivning").Select ActiveSheet.Protect Password:="tomstr" Range("a12").Select Range("a2").Select Range("a1").Select End Sub -- Tomas S |
#5
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
Actually, there where some hidden sheets in the file that I inherited, scilly
but true. whein I included also these into the list of sheets not to be handled it worked 100% perfect. So i could leave the merged cells as they are. Many thanks for the help!! -- Tomas S "Bob Phillips" skrev: Get rid of the merged cells, they are more trouble than they are worth. -- HTH Bob Phillips (remove nothere from email address if mailing direct) "Tomas Stroem" wrote in message ... Thanks Bob, Excellent help ! This made it much better, but there is still one thing that this did not solve. There are more than the 20 Identical sheets in the file that contain different calculations. I have achieved to avoid the texts being copied to all but one of the sheets. I get a run-time error '1004' warning that "Cannot change part of a merged cell" and then the following code is highlighted Sheets("Parametrar").Range("b40:e77").Copy _ sh.Range("A31") The mission is completed correctly but I dont want the error message to appear. ------ The full code I use is inserted below Sheets("Parametrar").Select ActiveSheet.Unprotect Password:="tomstr" Sheets("Parametrar").Range("b40:e77").Copy ActiveSheet.Unprotect Password:="tomstr" For Each sh In ActiveWorkbook.Worksheets If sh.Name < "Parametrar" And sh.Name < "Projektbeskrivning" And sh.Name < "Fritexter" And sh.Name < "Kassaflöde" And sh.Name < "Provision & Bank" And sh.Name < "Valutakurser" And sh.Name < "Aktiva" And sh.Name < "Sammanställning" And sh.Name < "Valuta & Betalningsplan" Then sh.Unprotect Password:="tomstr" Sheets("Parametrar").Range("b40:e77").Copy _ sh.Range("A31") sh.Protect Password:="tomstr" End If Next ActiveSheet.Protect Password:="tomstr" Sheets("Projektbeskrivning").Select ActiveSheet.Protect Password:="tomstr" Range("a12").Select Range("a2").Select Range("a1").Select End Sub -- Tomas S "Bob Phillips" skrev: Does this work for you? Sheets("Parametrar").Range("b40:e77").Copy ActiveSheet.Unprotect Password:="tomstr" For Each sh In ActiveWorkbook.Worksheets If sh.Name < "Parametrar" Then sh.Unprotect Password:="tomstr" Sheets("Parametrar").Range("b40:e77").Copy _ sh.Range("A1") sh.Protect Password:="tomstr" End If Next x ActiveSheet.Protect Password:="tomstr" -- HTH Bob Phillips (remove nothere from email address if mailing direct) "Tomas Stroem" wrote in message ... I want to insert a certain number of row texts into 20 identical spreadsheets. When I copy the area I want to insert then my macro stops after the first of the 20 sheets. I use "for x=1 to 20" "Next x" to acheive the repeated copy. Is there a simple way to get the result i want? 20 sheets in one Workbook The code I have is the following. It solves the problem but on slow machines in the organisation it takes time as I make three loops ----------------------------------------------------------- ActiveSheet.Unprotect Password:="tomstr" Sheets("Pos A").Select For x = 1 To 20 ActiveSheet.Unprotect Password:="tomstr" Range("a31").Select ActiveSheet.Next.Select Next x Sheets("Parametrar").Select Range("b40:e77").Select Application.CutCopyMode = False Selection.Copy Sheets("Pos A").Select For x = 1 To 20 ActiveSheet.Paste ActiveSheet.Next.Select Next x Sheets("Pos A").Select For x = 1 To 20 Range("a12").Select Range("a2").Select Range("a1").Select ActiveSheet.Protect Password:="tomstr" ActiveSheet.Next.Select Next x Sheets("Projektbeskrivning").Select ActiveSheet.Protect Password:="tomstr" Range("a12").Select Range("a2").Select Range("a1").Select End Sub -- Tomas S |
#6
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
I would still get rid of them. Another guy today had a macro that worked
fine for 11 out of 12 ranges. It did a cut and paste of some data, and it failed on the one range because of ... merged cells. -- HTH Bob Phillips (remove nothere from email address if mailing direct) "Tomas Stroem" wrote in message ... Actually, there where some hidden sheets in the file that I inherited, scilly but true. whein I included also these into the list of sheets not to be handled it worked 100% perfect. So i could leave the merged cells as they are. Many thanks for the help!! -- Tomas S "Bob Phillips" skrev: Get rid of the merged cells, they are more trouble than they are worth. -- HTH Bob Phillips (remove nothere from email address if mailing direct) "Tomas Stroem" wrote in message ... Thanks Bob, Excellent help ! This made it much better, but there is still one thing that this did not solve. There are more than the 20 Identical sheets in the file that contain different calculations. I have achieved to avoid the texts being copied to all but one of the sheets. I get a run-time error '1004' warning that "Cannot change part of a merged cell" and then the following code is highlighted Sheets("Parametrar").Range("b40:e77").Copy _ sh.Range("A31") The mission is completed correctly but I dont want the error message to appear. ------ The full code I use is inserted below Sheets("Parametrar").Select ActiveSheet.Unprotect Password:="tomstr" Sheets("Parametrar").Range("b40:e77").Copy ActiveSheet.Unprotect Password:="tomstr" For Each sh In ActiveWorkbook.Worksheets If sh.Name < "Parametrar" And sh.Name < "Projektbeskrivning" And sh.Name < "Fritexter" And sh.Name < "Kassaflöde" And sh.Name < "Provision & Bank" And sh.Name < "Valutakurser" And sh.Name < "Aktiva" And sh.Name < "Sammanställning" And sh.Name < "Valuta & Betalningsplan" Then sh.Unprotect Password:="tomstr" Sheets("Parametrar").Range("b40:e77").Copy _ sh.Range("A31") sh.Protect Password:="tomstr" End If Next ActiveSheet.Protect Password:="tomstr" Sheets("Projektbeskrivning").Select ActiveSheet.Protect Password:="tomstr" Range("a12").Select Range("a2").Select Range("a1").Select End Sub -- Tomas S "Bob Phillips" skrev: Does this work for you? Sheets("Parametrar").Range("b40:e77").Copy ActiveSheet.Unprotect Password:="tomstr" For Each sh In ActiveWorkbook.Worksheets If sh.Name < "Parametrar" Then sh.Unprotect Password:="tomstr" Sheets("Parametrar").Range("b40:e77").Copy _ sh.Range("A1") sh.Protect Password:="tomstr" End If Next x ActiveSheet.Protect Password:="tomstr" -- HTH Bob Phillips (remove nothere from email address if mailing direct) "Tomas Stroem" wrote in message ... I want to insert a certain number of row texts into 20 identical spreadsheets. When I copy the area I want to insert then my macro stops after the first of the 20 sheets. I use "for x=1 to 20" "Next x" to acheive the repeated copy. Is there a simple way to get the result i want? 20 sheets in one Workbook The code I have is the following. It solves the problem but on slow machines in the organisation it takes time as I make three loops ----------------------------------------------------------- ActiveSheet.Unprotect Password:="tomstr" Sheets("Pos A").Select For x = 1 To 20 ActiveSheet.Unprotect Password:="tomstr" Range("a31").Select ActiveSheet.Next.Select Next x Sheets("Parametrar").Select Range("b40:e77").Select Application.CutCopyMode = False Selection.Copy Sheets("Pos A").Select For x = 1 To 20 ActiveSheet.Paste ActiveSheet.Next.Select Next x Sheets("Pos A").Select For x = 1 To 20 Range("a12").Select Range("a2").Select Range("a1").Select ActiveSheet.Protect Password:="tomstr" ActiveSheet.Next.Select Next x Sheets("Projektbeskrivning").Select ActiveSheet.Protect Password:="tomstr" Range("a12").Select Range("a2").Select Range("a1").Select End Sub -- Tomas S |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
How to convert cell formula functions to code functions | Excel Discussion (Misc queries) | |||
efficiency: database functions vs. math functions vs. array formula | Excel Discussion (Misc queries) | |||
Looking for a site with functions that substitute the ATP functions | Excel Worksheet Functions | |||
Nestling functions | Excel Programming | |||
excel functions and User defined functions | Excel Programming |