Insert rows/copy formulas fro above

[Steve]

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

 

[Bob Phillips]

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]

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

 

[Bob Phillips]

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)