Copy format from row above for selected cells
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
'<<=============
---
Regards,
Norman
"al007" wrote in message
oups.com...
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
|