Sub RemoveAllBorders()
Dim calcModus&, updateModus&, i
Dim rng As Range, ar As Range
Dim brd As Border
If Selection Is Nothing Then Exit Sub
calcModus = Application.Calculation
updateModus = Application.ScreenUpdating
Application.Calculation = xlManual
Application.ScreenUpdating = False
For Each ar In Selection.Areas
For Each rng In ar
For Each i In Array(xlEdgeTop, xlEdgeBottom, xlEdgeLeft, xlEdgeRight, xlDiagonalDown, xlDiagonalUp)
rng.Borders(i).LineStyle = xlLineStyleNone
Next i
If rng.Column > 1 Then
rng.Offset(0, -1).Borders(xlRight).LineStyle = xlLineStyleNone
End If
If rng.Column < 256 Then
rng.Offset(0, 1).Borders(xlLeft).LineStyle = xlLineStyleNone
End If
If rng.Row > 1 Then
rng.Offset(-1, 0).Borders(xlBottom).LineStyle = xlLineStyleNone
End If
If rng.Row < 65536 Then
rng.Offset(1, 0).Borders(xlTop).LineStyle = xlLineStyleNone
End If
Next rng
Next ar
Application.Calculation = calcModus
Application.ScreenUpdating = updateModus
End Sub