Hi,

I have a short piece of code that finds the last entry in a row and then
inserts a new column. what should happen is that all formats from should be
duplicated, but for some reason cell borders are not being copied.

Set rCtr = Sheets("badges").Range("d1") ' add new name to badges
list
Do
If rCtr.Value <> "" Then
Set rCtr = rCtr.Offset(0, 1)
Else
rCtr.EntireColumn.Insert ,_
CopyOrigin:=xlFormatFromLeftOrAbove
rCtr.Offset(0, -1) = FmNewBeaver.tbName
Exit Do
End If
Loop

Can anyone suggest why this is happening and how to fix it?

TIA

Dave

Try this vba

Sub copycolSAS()
Dim lc As Long
With Sheets("badges")
lc = .Cells(1, Columns.Count).End(xlToLeft).Column
.Columns("d").Copy
.Columns(lc).Insert
End With
Application.CutCopyMode = False
End Sub

--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(E-Mail Removed)
"Risky Dave" <(E-Mail Removed)> wrote in message
news:2850FF43-8098-43B2-89E9-(E-Mail Removed)...
> Hi,
>
> I have a short piece of code that finds the last entry in a row and then
> inserts a new column. what should happen is that all formats from should
> be
> duplicated, but for some reason cell borders are not being copied.
>
> Set rCtr = Sheets("badges").Range("d1") ' add new name to badges
> list
> Do
> If rCtr.Value <> "" Then
> Set rCtr = rCtr.Offset(0, 1)
> Else
> rCtr.EntireColumn.Insert ,_
> CopyOrigin:=xlFormatFromLeftOrAbove
> rCtr.Offset(0, -1) = FmNewBeaver.tbName
> Exit Do
> End If
> Loop
>
> Can anyone suggest why this is happening and how to fix it?
>
> TIA
>
> Dave