الخيار "نسخ الحدود فقط"

Sub CopyBorders()

Dim xRg, yRg As Range

On Error Resume Next



Set xRg = Application.InputBox("Select Range with Borders to Copy...", "Kutools For Excel", , , , , , 8)

Set yRg = Application.InputBox("Select Cells to Apply Borders to range..", "Kutools For Excel", , , , , , 8)



With yRg.Borders(xlEdgeLeft)

.LineStyle = xRg.Borders(xlEdgeLeft).LineStyle

.ColorIndex = xRg.Borders(xlEdgeLeft).ColorIndex

.TintAndShade = xRg.Borders(xlEdgeLeft).TintAndShade

.Weight = xRg.Borders(xlEdgeLeft).Weight

End With

With yRg.Borders(xlEdgeTop)

.LineStyle = xRg.Borders(xlEdgeTop).LineStyle

.ColorIndex = xRg.Borders(xlEdgeTop).ColorIndex

.TintAndShade = xRg.Borders(xlEdgeTop).TintAndShade

.Weight = xRg.Borders(xlEdgeTop).Weight

End With

With yRg.Borders(xlEdgeBottom)

.LineStyle = xRg.Borders(xlEdgeBottom).LineStyle

.ColorIndex = xRg.Borders(xlEdgeBottom).ColorIndex

.TintAndShade = xRg.Borders(xlEdgeBottom).TintAndShade

.Weight = xRg.Borders(xlEdgeBottom).Weight

End With

With yRg.Borders(xlEdgeRight)

.LineStyle = xRg.Borders(xlEdgeRight).LineStyle

.ColorIndex = xRg.Borders(xlEdgeRight).ColorIndex

.TintAndShade = xRg.Borders(xlEdgeRight).TintAndShade

.Weight = xRg.Borders(xlEdgeRight).Weight

End With

With yRg.Borders(xlInsideHorizontal)

.LineStyle = xRg.Borders(xlInsideHorizontal).LineStyle

.ColorIndex = xRg.Borders(xlInsideHorizontal).ColorIndex

.TintAndShade = xRg.Borders(xlInsideHorizontal).TintAndShade

.Weight = xRg.Borders(xlInsideHorizontal).Weight

End With

With yRg.Borders(xlInsideVertical)

.LineStyle = xRg.Borders(xlInsideVertical).LineStyle

.ColorIndex = xRg.Borders(xlInsideVertical).ColorIndex

.TintAndShade = xRg.Borders(xlInsideVertical).TintAndShade

.Weight = xRg.Borders(xlInsideVertical).Weight

End With

End Sub