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
- Nov 21 Wed 2007 20:40
insert row with formula etc carried from above
close
全站熱搜
留言列表
發表留言