In Excel VBA, I am trying to copy only a cell's border and paste it on another cell (no change to value, number format, etc.)

Question

The idea is if I press ctrl+c on a cell with the desired border formats, and then click on a new cell that I want the desired border applied to, I can then run the macro and only the cell border will be applied. To clarify, the original font, number format, size, color, alignment will not have changed in the cell that now has the new border.

Update

Example code:

Cells(1, 1).Formula = ActiveCell.Formula
Cells(1, 1).Font.Color = ActiveCell.Font.Color

Cells(1, 1).Font.ColorIndex = ActiveCell.Font.ColorIndex
Cells(1, 1).Font.Bold = ActiveCell.Font.Bold
Cells(1, 1).Font.FontStyle = ActiveCell.Font.Name
Cells(1, 1).Font.Size = ActiveCell.Font.Size
Cells(1, 1).NumberFormat = ActiveCell.NumberFormat
Cells(1, 1).HorizontalAlignment = ActiveCell.HorizontalAlignment
Cells(1, 1).VerticalAlignment = ActiveCell.VerticalAlignment
Cells(1, 1).WrapText = ActiveCell.WrapText
ActiveSheet.Paste
ActiveCell.Formula = Cells(1, 1).Formula
ActiveCell.Font.Color = Cells(1, 1).Font.Color
ActiveCell.Font.ColorIndex = Cells(1, 1).Font.ColorIndex
ActiveCell.Font.Bold = Cells(1, 1).Font.Bold
ActiveCell.Font.Name = Cells(1, 1).Font.Name
ActiveCell.Font.Size = Cells(1, 1).Font.Size
ActiveCell.NumberFormat = Cells(1, 1).NumberFormat
ActiveCell.HorizontalAlignment = Cells(1, 1).HorizontalAlignment
ActiveCell.VerticalAlignment = Cells(1, 1).VerticalAlignment
ActiveCell.WrapText = Cells(1, 1).WrapText
Cells(1, 1).Clear

This works, but it causes a debug error on the ActiveSheet.paste line. But if I run it again with debug, it then works.

Second Update

Unfortunately your solutions seemed a bit too complex for a layman like myself. I do believe I have solved what I was looking for with below:

Sub Test()

Dim RowRef, ColRef, Alignment As Integer
Dim Color As Double
Dim NumForm, Formula As String

RowRef = ActiveCell.Row
ColRef = ActiveCell.Column

NumForm = Cells(RowRef, ColRef).NumberFormat
Formula = Cells(RowRef, ColRef).Formula
Color = Cells(RowRef, ColRef).Font.Color
Alignment = Cells(RowRef, ColRef).HorizontalAlignment

Cells(RowRef, ColRef).PasteSpecial (xlPasteAll)

Cells(RowRef, ColRef).NumberFormat = NumForm
Cells(RowRef, ColRef).Formula = Formula
Cells(RowRef, ColRef).Font.Color = Color
Cells(RowRef, ColRef).HorizontalAlignment = Alignment

End Sub

I can simply add more characteristics of what I want to keep the same formatting, but the gist of the solution seems to be the above. If you have a second to confirm or provide any direction on how to improve more please let me know.

Answer 1

TechnoDabbler's code does not work for me. Trying to copy the LineStyle and Color of all borders at once creates black borders inside and out, irrespective of the borders of the CopyCells.

ashleedawg's code is almost complete, there is just one problem. As TechnoDabbler noted, when setting border properties, there appears to be some stuff happening in the background. It seems to me that when setting the lineStyle of a border, the color is automatically set to 0. And when setting the weight of a border that does not exist (i.e. linestyle = xlLineStyleNone), that border be created.

Therefore, you just have to add an if-statement to make it work:

For Each bs In arr
    With bFrom(bs)
        If Not .LineStyle = xlLineStyleNone Then 
            bTo(bs).Color = .Color
            bTo(bs).ColorIndex = .ColorIndex
            bTo(bs).LineStyle = .LineStyle
            bTo(bs).TintAndShade = .TintAndShade
            bTo(bs).Weight = .Weight
        End If
    End With
Next bs

Answer 2

This is an answer... but also isn't — since it doesn't quite work as is, but maybe someone can fill in the blanks.

There must be to be a way to do this using the Borders object, which is a collection of four Border objects.

I'd thought I'd be able to For Each-loop through either the XlBordersIndex enumeration, or the Borders property of the range, like:

For Each b in Range("A1:A4").Border

...and then set the properties, such as XlBorderWeight and XlLineStyle.

However, I experimented with a few possible solutions but nothing performed quite as expected.

For example:

Sub copyBorders()
    Dim rgFrom As Range:  Set rgFrom = ThisWorkbook.Sheets("Sheet1").Range("A1")
    Dim rgTo As Range:    Set rgTo = ThisWorkbook.Sheets("Sheet1").Range("C1")

    Dim bFrom As Borders: Set bFrom = rgFrom.Borders
    Dim bTo As Borders:   Set bTo = rgTo.Borders

    Dim arr, bs
    arr = Array(xlDiagonalDown, xlDiagonalUp, xlEdgeBottom, xlEdgeLeft, _
                xlEdgeRight, xlEdgeTop, xlInsideHorizontal, xlInsideVertical)

    For Each bs In arr  'same as using `For bs = 5 to 12`
        With bFrom(bs)
            bTo(bs).Color = .Color
            bTo(bs).ColorIndex = .ColorIndex
            bTo(bs).LineStyle = .LineStyle
            bTo(bs).TintAndShade = .TintAndShade
            bTo(bs).Weight = .Weight
        End With
    Next bs
End Sub

...and the odd result of my attempt to match C1's borders to A1:

I'll probably never have a reason to use this myself but am nonetheless curious how to make this method work, and confused as to why I got the result I did.

---

I first thought/hoped it would be as easy as:

Range1.Borders = Range2.Borders

...or at least something like:

Range1.Borders(xlEdgeRight) = Range2.Borders(xlEdgeRight)

...but no such luck.

Answer 3

An interesting challenge. It is variation of what @user1274820 describes in:

Excel VBA - Get copied cell address when the active/selected cell is different

In ThisWorkbook put the following code:

Option Explicit

Private Sub Workbook_Open()
    Application.OnKey "^c", "CopyEvent"
End Sub

In a module, place the following code:

Option Explicit

Dim CopyCells As Range

Private Sub CopyEvent()
    Set CopyCells = Selection
    Selection.Copy
End Sub

Public Sub PasteBorders()
    If Not CopyCells Is Nothing Then
        ActiveCell.Borders().LineStyle = CopyCells.Borders().LineStyle
        ActiveCell.Borders().Color = CopyCells.Borders().Color
    End If
End Sub

Save/close the workbook and re-open it to run the Workbook_Open for the first time.

The trick is that a copied range is not normally accessible, so it is explicitly saved when Ctrl-C is pressed. When the PasteBorders code is run, it only copies the linestyle and color from the selected range.