the following routines were written to add a row above or below the "active"
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 = "Arial"
.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 = "Arial"
.Font.Size = 8
End With
Application.ScreenUpdating = True
End Sub
' ===== ===== ===== ===== ===== ===== ===== ===== ===== =====
Regards
Trevor
HenryAlive said:
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