|
Insert rows/copy formulas fro above
Hi everyone. I have some code below that is (or supposed) to insert a
number of rows (based on an input from the user) on several sheets included in the array, and then copy the formulas from the row abover and copy intot he newly created rows. All works great on the firt sheet (named Data). BUT, the code does not insert rows or copy formulas in any of the other sheets in the array. Any ideas what I'm doing wrong?? Thanks!! Sub New_Project() Dim ws As Worksheet Dim x As Integer x = InputBox("How many rows do you want to insert?") For Each ws In Worksheets ws.Visible = xlSheetVisible Next Range("B5000").End(xlUp).Select Sheets(Array("Data", "Sheet1", "Sheet2", Sheet3", "Sheet4")).Select Sheets("Data").Activate ActiveCell.Offset(1, 0).Resize(x, 1).EntireRow.Insert ActiveCell.Offset(-2 - x, 0).Select ActiveCell.EntireRow.Copy ActiveCell.Offset(1, 0).Resize(x, 1).EntireRow.PasteSpecial Paste:=xlFormulas Application.CutCopyMode = False Selection.End(xlToLeft).Select Sheets("Data").Select Sheets("Data").Range("B5000").End(xlUp).Offset(1, -1).Resize(x, 36).ClearContents Sheets("Data").Select End Sub |
Insert rows/copy formulas fro above
Try looping through the array, activating each sheet and processing it.
-- HTH Bob (there's no email, no snail mail, but somewhere should be gmail in my addy) "Steve" wrote in message oups.com... Hi everyone. I have some code below that is (or supposed) to insert a number of rows (based on an input from the user) on several sheets included in the array, and then copy the formulas from the row abover and copy intot he newly created rows. All works great on the firt sheet (named Data). BUT, the code does not insert rows or copy formulas in any of the other sheets in the array. Any ideas what I'm doing wrong?? Thanks!! Sub New_Project() Dim ws As Worksheet Dim x As Integer x = InputBox("How many rows do you want to insert?") For Each ws In Worksheets ws.Visible = xlSheetVisible Next Range("B5000").End(xlUp).Select Sheets(Array("Data", "Sheet1", "Sheet2", Sheet3", "Sheet4")).Select Sheets("Data").Activate ActiveCell.Offset(1, 0).Resize(x, 1).EntireRow.Insert ActiveCell.Offset(-2 - x, 0).Select ActiveCell.EntireRow.Copy ActiveCell.Offset(1, 0).Resize(x, 1).EntireRow.PasteSpecial Paste:=xlFormulas Application.CutCopyMode = False Selection.End(xlToLeft).Select Sheets("Data").Select Sheets("Data").Range("B5000").End(xlUp).Offset(1, -1).Resize(x, 36).ClearContents Sheets("Data").Select End Sub |
Insert rows/copy formulas fro above
Hi Bob. Funny you mention that. I thought of that last night, but
couldn't get the syntax right. to work. Here's what I tried, but didn't work. Can you help? Sub New_Project() Dim ws As Worksheet Dim x As Integer x = InputBox("How many rows do you want to insert?") For Each ws In Worksheets ws.Visible = xlSheetVisible Next Range("B5000").End(xlUp).Select mysheets=Array("Data", "Sheet1", "Sheet2", Sheet3", "Sheet4") For each sht in mysheets sht.Range("B5000").End(xlUp).Select ActiveCell.Offset(1, 0).Resize(x, 1).EntireRow.Insert ActiveCell.Offset(-2 - x, 0).Select ActiveCell.EntireRow.Copy ActiveCell.Offset(1, 0).Resize(x, 1).EntireRow.PasteSpecial Paste:=xlFormulas Application.CutCopyMode = False Selection.End(xlToLeft).Select Next sht Sheets("Data").Select Sheets("Data").Range("B5000").End(xlUp).Offset(1, -1).Resize(x, 36).ClearContents Sheets("Data").Select End Sub On Aug 7, 1:37 am, "Bob Phillips" wrote: Try looping through the array, activating each sheet and processing it. -- HTH Bob (there's no email, no snail mail, but somewhere should be gmail in my addy) "Steve" wrote in message oups.com... Hi everyone. I have some code below that is (or supposed) to insert a number of rows (based on an input from the user) on several sheets included in the array, and then copy the formulas from the row abover and copy intot he newly created rows. All works great on the firt sheet (named Data). BUT, the code does not insert rows or copy formulas in any of the other sheets in the array. Any ideas what I'm doing wrong?? Thanks!! Sub New_Project() Dim ws As Worksheet Dim x As Integer x = InputBox("How many rows do you want to insert?") For Each ws In Worksheets ws.Visible = xlSheetVisible Next Range("B5000").End(xlUp).Select Sheets(Array("Data", "Sheet1", "Sheet2", Sheet3", "Sheet4")).Select Sheets("Data").Activate ActiveCell.Offset(1, 0).Resize(x, 1).EntireRow.Insert ActiveCell.Offset(-2 - x, 0).Select ActiveCell.EntireRow.Copy ActiveCell.Offset(1, 0).Resize(x, 1).EntireRow.PasteSpecial Paste:=xlFormulas Application.CutCopyMode = False Selection.End(xlToLeft).Select Sheets("Data").Select Sheets("Data").Range("B5000").End(xlUp).Offset(1, -1).Resize(x, 36).ClearContents Sheets("Data").Select End Sub- Hide quoted text - - Show quoted text - |
Insert rows/copy formulas fro above
Not properly tested, but try this
Sub New_Project() Dim sht As Worksheet Dim mySheets() Dim ws As Worksheet Dim i As Long Dim x As Integer x = InputBox("How many rows do you want to insert?") For Each ws In Worksheets ws.Visible = xlSheetVisible Next mySheets = Array("Data", "Sheet1", "Sheet2", "Sheet3", "Sheet4") For i = LBound(mySheets) To UBound(mySheets) With Worksheets(mySheets(i)).Range("B5000").End(xlUp) .Offset(1, 0).Resize(x, 1).EntireRow.Insert .Offset(-2 - x, 0).EntireRow.Copy .Offset(1, 0).Resize(x, 1).EntireRow.PasteSpecial Paste:=xlFormulas .End(xlToLeft).Select End With Application.CutCopyMode = False Next i Sheets("Data").Range("B5000").End(xlUp).Offset(1, -1).Resize(x, 36).ClearContents Sheets("Data").Select End Sub -- HTH Bob (there's no email, no snail mail, but somewhere should be gmail in my addy) "Steve" wrote in message ups.com... Hi Bob. Funny you mention that. I thought of that last night, but couldn't get the syntax right. to work. Here's what I tried, but didn't work. Can you help? Sub New_Project() Dim ws As Worksheet Dim x As Integer x = InputBox("How many rows do you want to insert?") For Each ws In Worksheets ws.Visible = xlSheetVisible Next Range("B5000").End(xlUp).Select mysheets=Array("Data", "Sheet1", "Sheet2", Sheet3", "Sheet4") For each sht in mysheets sht.Range("B5000").End(xlUp).Select ActiveCell.Offset(1, 0).Resize(x, 1).EntireRow.Insert ActiveCell.Offset(-2 - x, 0).Select ActiveCell.EntireRow.Copy ActiveCell.Offset(1, 0).Resize(x, 1).EntireRow.PasteSpecial Paste:=xlFormulas Application.CutCopyMode = False Selection.End(xlToLeft).Select Next sht Sheets("Data").Select Sheets("Data").Range("B5000").End(xlUp).Offset(1, -1).Resize(x, 36).ClearContents Sheets("Data").Select End Sub On Aug 7, 1:37 am, "Bob Phillips" wrote: Try looping through the array, activating each sheet and processing it. -- HTH Bob (there's no email, no snail mail, but somewhere should be gmail in my addy) "Steve" wrote in message oups.com... Hi everyone. I have some code below that is (or supposed) to insert a number of rows (based on an input from the user) on several sheets included in the array, and then copy the formulas from the row abover and copy intot he newly created rows. All works great on the firt sheet (named Data). BUT, the code does not insert rows or copy formulas in any of the other sheets in the array. Any ideas what I'm doing wrong?? Thanks!! Sub New_Project() Dim ws As Worksheet Dim x As Integer x = InputBox("How many rows do you want to insert?") For Each ws In Worksheets ws.Visible = xlSheetVisible Next Range("B5000").End(xlUp).Select Sheets(Array("Data", "Sheet1", "Sheet2", Sheet3", "Sheet4")).Select Sheets("Data").Activate ActiveCell.Offset(1, 0).Resize(x, 1).EntireRow.Insert ActiveCell.Offset(-2 - x, 0).Select ActiveCell.EntireRow.Copy ActiveCell.Offset(1, 0).Resize(x, 1).EntireRow.PasteSpecial Paste:=xlFormulas Application.CutCopyMode = False Selection.End(xlToLeft).Select Sheets("Data").Select Sheets("Data").Range("B5000").End(xlUp).Offset(1, -1).Resize(x, 36).ClearContents Sheets("Data").Select End Sub- Hide quoted text - - Show quoted text - |
| All times are GMT +1. The time now is 12:14 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com