Help inserting a new row into several worksheets and copy formula

[c001m4n]

I am new to this forum and I'm here seeking your expert help.

I am using excel 2007

I am looking to create a macro for users to insert a new row where they specify and will copy only the format and formula from the above row.
This new row will be inserted at the same row number across several, but not all worksheets.
Worksheet set up: ie. DataA, DataB, Chart1, DataC. I want to insert a new row into DataX sheets.

I have a really basic programming knowledge. I can read the code and understand most of it, but I do not know how to write the code.


This is the code I found on this site which does some of what I am looking for:

[VBA]Option Explicit

Sub InsertRowAllSheets()

' Thanks to firefytr for the code that has been adapted into this routine

Dim cs As String
cs = ActiveSheet.Name
Dim y As Integer
y = Application.InputBox("Enter the row number you wish to add", _
Type:=1) 'enter 16 to insert a new row 16, the old row _
will become 17 And all other rows push down 1 row As well.
If MsgBox("Are you sure you wish to insert at row " & y & " for ALL sheets?", _
vbYesNo, "Insert row on ALL Sheets") = vbNo Then Exit Sub
Application.ScreenUpdating = False
Dim r As Range
Dim ws As Worksheet
' On Error Resume Next 'Error handler
For Each ws In ThisWorkbook.Worksheets
ws.Activate
Set r = ActiveSheet.Range("A" & y)
If y < 7 Then Goto circumv 'Not to insert in Headers
Range("A" & y).EntireRow.Insert

' code can be inserted here to copy formulas for some or all sheets in the workbook

circumv:
Next ws
Sheets(cs).Activate
Application.ScreenUpdating = True

End Sub
[/VBA]

Except I do not know what to modify to target the new row into the separate worksheets, nor what copy and paste code to enter.

[mancubus]

wellcome to VBAX.

try below code with a copy of your file.

[VBA]
Sub InsertRowsToAllWorksheets()

Dim cs As String
Dim InsRow As Integer
Dim ws As Worksheet

cs = ActiveSheet.Name

InsRow = Application.InputBox("Enter the row number you wish to add", Type:=1)

If InsRow < 3 Then 'change this number to suit your requirement
MsgBox "You cannot insert rows before header and first data row"
Exit Sub
End If

If MsgBox("Are you sure you wish to insert at row " & InsRow & " for ALL sheets?", _
vbYesNo, "Insert row on ALL Sheets") = vbNo Then Exit Sub

Application.ScreenUpdating = False

For Each ws In ThisWorkbook.Worksheets
With ws
If Left(UCase(.Name), 4) = UCase("data") Then
.Activate
.Rows(InsRow).Insert
.Rows(InsRow - 1).Copy
.Rows(InsRow).PasteSpecial xlPasteFormulas
.Rows(InsRow).PasteSpecial xlPasteFormats
End If
End With
Next ws

Application.CutCopyMode = False

Sheets(cs).Activate

Application.ScreenUpdating = True

End Sub

[/VBA]

[c001m4n]

Thanks for your help!

I asked the same question in another forum and got some help as well. I figured out some of these codes. Below is what I used, it's probably not fully optimized, but it works.

This is for rows or columns in all sheets ending in "Data". No input box for row/column number.

[VBA]Sub InsertRowAllDataSheets_NoInputBox()

Dim cs As String
Dim r As Long
cs = ActiveSheet.Name
r = Selection.Row
Application.ScreenUpdating = False
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
If ws.Name Like "*Data" Then
ws.Activate
Rows(r & ":" & r).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Rows(r - 1 & ":" & r - 1).Select
Selection.Copy
Rows(r & ":" & r).Select
Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End If
Next ws
Sheets(cs).Activate
Application.ScreenUpdating = True

End Sub

Sub InsertColAllDataSheets_NoInputBox()

Dim cs As String
Dim c As Long
cs = ActiveSheet.Name
c = Selection.Column
Application.ScreenUpdating = False
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
If ws.Name Like "*Data" Or ws.Name Like "*Info" Then
ws.Activate
Columns(c).Insert , CopyOrigin:=xlFormatFromLeftOrAbove
Columns(c - 1).Select
Selection.Copy
Columns(c).Select
Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End If
Next ws
Sheets(cs).Activate
Application.ScreenUpdating = True

End Sub[/VBA]

[mancubus]

you're wellcome.

please refer http://www.excelguru.ca/content.php?184 when cross posting.