Copy format from row above for selected cells

[al007]

Sub FormatasRowAbove()
Dim rng As Range
Set rng = ActiveCell
Rows(rng.Row - 1).Copy
Cells(rng.Row, 1).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
rng.Select
End Sub

How can I make above macro work for an area of cells

i.e

By selecting A2:A7 - I would like row 2 & row 7 to have same format as
row 1

Thxs

 

[Norman Jones]

Hi Al007,

If your intent is to copy the formats of row 1 to the first and last rows of
the designated range, try:

'=============>>
Public Sub FormatasRowAbove1()
Dim rng As Range
Dim currCell As Range
Dim currRng As Range

Set currRng = Selection
Set currCell = ActiveCell
Set rng = Range("A2:A7")

Rows(rng.Row - 1).Copy
rng(1).EntireRow.PasteSpecial Paste:=xlPasteFormats
rng(rng.Count).EntireRow.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
currRng.Select
currCell.Activate

End Sub
'<<=============

If, however your intent was to copy the formats to all the rows in the
designated range, then try instead:

'=============>>
Public Sub FormatasRowAbove2()
Dim rng As Range
Dim currCell As Range
Dim currRng As Range

Set currRng = Selection
Set currCell = ActiveCell
Set rng = Range("A2:A7")

Rows(rng.Row - 1).Copy
rng.EntireRow.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
currRng.Select
currCell.Activate

End Sub
'<<=============

 

[al007]

thxs