Hi,
Try this. I've included the code to add the borders but you can delete this
if you want to do it manually. Not this will not work for conditionally
formatted coloured cells
Sub sonic()
Dim CopyRange As Range
For Each c In ActiveSheet.UsedRange
If c.Interior.ColorIndex <> xlNone Then
If CopyRange Is Nothing Then
Set CopyRange = c
Else
Set CopyRange = Union(CopyRange, c)
End If
End If
Next
CopyRange.Select
'delete from here to end
'if you want to do the border manually
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = xlMedium
End With
End Sub
--
Mike
When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.