close

I need to insert rows in a wat that the inserted row carries the format and
formulae of the row immediately above. The key part of the formating above is
2 cells merged into one [because of stff elsewhere in the worksheet] and the
formulae above. This is a form to be used by others and I am inserting into a
protected sheet with the insert rows box in Protection checked.

This sort of thinh used to work in Supercalc [remember that one] but
apparently not in Excel

Thanks

the following routines were written to add a row above or below the quot;activequot;
row, copy any formulae and formats and add some borders and fonts, etc. May
not be exactly what you want but they should set you off in the right
direction:

Option Explicit
Option Private Module

' ===== ===== ===== ===== ===== ===== ===== ===== ===== =====
Sub InsertAbove()
' ===== ===== ===== ===== ===== ===== ===== ===== ===== =====

Dim BaseCell As Range
Dim BaseRange As Range
Dim BaseRow As Long
Dim FirstCell As Long
Dim LastCell As Long
Dim c As Range

Set BaseCell = ActiveCell
BaseRow = BaseCell.Row
LastCell = Cells(1, Columns.Count).End(xlToLeft).Column

Set BaseRange = Range(Cells(BaseRow, 1), Cells(BaseRow, LastCell))

Application.ScreenUpdating = False

BaseCell.EntireRow.Insert

For Each c In BaseRange
If c.HasFormula Then
c.Offset(-1, 0).FormulaR1C1 = c.FormulaR1C1
c.Copy
c.Offset(-1, 0).PasteSpecial Paste:=xlFormats
Application.CutCopyMode = False
End If
Next 'c

Cells(BaseRow, 1).Select

With BaseRange.Offset(-1, 0)
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Interior.ColorIndex = xlNone
.Font.ColorIndex = 0
.Font.Name = quot;Arialquot;
.Font.Size = 8
End With

Application.ScreenUpdating = True

End Sub

' ===== ===== ===== ===== ===== ===== ===== ===== ===== =====
Sub InsertBelow()
' ===== ===== ===== ===== ===== ===== ===== ===== ===== =====

Dim BaseCell As Range
Dim BaseRange As Range
Dim BaseRow As Long
Dim FirstCell As Long
Dim LastCell As Long
Dim c As Range

Set BaseCell = ActiveCell
BaseRow = BaseCell.Row
LastCell = Cells(1, Columns.Count).End(xlToLeft).Column

Set BaseRange = Range(Cells(BaseRow, 1), Cells(BaseRow, LastCell))

Application.ScreenUpdating = False

BaseCell.Offset(1, 0).EntireRow.Insert

For Each c In BaseRange
If c.HasFormula Then
c.Offset(1, 0).FormulaR1C1 = c.FormulaR1C1
c.Copy
c.Offset(1, 0).PasteSpecial Paste:=xlFormats
Application.CutCopyMode = False
End If
Next 'c

Cells(BaseRow, 1).Offset(1, 0).Select

With BaseRange.Offset(1, 0)
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Interior.ColorIndex = xlNone
.Font.ColorIndex = 0
.Font.Name = quot;Arialquot;
.Font.Size = 8
End With

Application.ScreenUpdating = True

End Sub

' ===== ===== ===== ===== ===== ===== ===== ===== ===== =====

Regards

Trevorquot;HenryAlivequot; gt; wrote in message
...
gt;I need to insert rows in a wat that the inserted row carries the format and
gt; formulae of the row immediately above. The key part of the formating above
gt; is
gt; 2 cells merged into one [because of stff elsewhere in the worksheet] and
gt; the
gt; formulae above. This is a form to be used by others and I am inserting
gt; into a
gt; protected sheet with the insert rows box in Protection checked.
gt;
gt; This sort of thinh used to work in Supercalc [remember that one] but
gt; apparently not in Excel
gt;
gt; Thanks

arrow
arrow
    全站熱搜
    創作者介紹
    創作者 software 的頭像
    software

    software

    software 發表在 痞客邦 留言(0) 人氣()