hi,
the copy command copies all. but you can selectively paste what was copied.
this is the line that is giving you the problem
Range(Cells(2, 6), Cells(2, 7)).Copy _
Destination:=Range(Cells(x, 1), Cells(x, 2))
this would paste all.
I might suggest this...
Range(Cells(2, 6), Cells(2, 7)).Copy
Range(Cells(x, 1), Cells(x, 2)).pastespecial xlAllExceptBorders
note: you can replace xlAllExceptBorders with 6
There are other pastespecials.
In vb help type Pastespecial to learn more.

regards
FSt1

"Adam" wrote:

Sorry I had some errors in the code I posted in the original message.

Private Sub Insert_Click()

Dim x, y

x = 1

Do Until y = 1

If Cells(x, 1) = "" Then

Range(Cells(2, 6), Cells(2, 7)).Copy _
Destination:=Range(Cells(x, 1), Cells(x, 2))
Range(Cells(2, 6), Cells(2, 7)).ClearContents
Worksheets("Sheet1").Range("A1").Sort _
Key1:=Worksheets("Sheet1").Columns("b"), _
Key1:=Worksheets("Sheet1").Columns("a"), _
Header:=xlGuess

y = 1

End If

x = x + 1

Loop ' End Do Until Loop


End Sub

"Adam" wrote:

Hello,

I have a long list of values in one sheet of an Excel Workbook. The list
only spans Column A & B. I have 2 cells (F2, G2) in which I enter new values
to be put into the list. After entering the new values in the 2 cells I
created a button that has code to look for an open row, paste the new entry,
then clear the contents of the entry cells(F2, G2).

Everything is working perfectly except that I have border formatting on my
entry cells and that formatting also copies to the list cells. Using the VB
code, is there a way to only copy the text out of the cell and past rather
than copying the properties of the cell as well?

I've pasted my button code as a reference.

Private Sub Insert_Click()

Dim x, y

Do Until y = 1

If Cells(x, 1) = "" Then

Range(Cells(2, 6), Cells(2, 7)).Value.Copy _
Destination:=Range(Cells(x, 1), Cells(x, 2))
Range(Cells(2, 6), Cells(2, 7)).ClearContents
Worksheets("Sheet1").Range("A1").Sort _
Key1:=Worksheets("Sheet1").Columns("b"), _
Key1:=Worksheets("Sheet1").Columns("a"), _
Header:=xlGuess

y = 1

End If

x = x + 1

Loop ' End Do Until Loop
End Sub


Thanks in advance for any help.