One way. This will need to be adapted as required :-

'----------------------------------
Sub test()
Dim FromSheet As Worksheet
Dim ToSheet As Worksheet
Dim C1 As String ' top of copy range
Dim C2 As String ' bottom of copy range
Dim LastRow As Long
'- from
Set FromSheet = ActiveSheet
C1 = "B3" ' top of pt column
C2 = "B" & FromSheet.Range(C1).End(xlDown).Row
'-to
FromSheet.Range(C1 & ":" & C2).Copy
Set ToSheet = ThisWorkbook.Worksheets("Sheet1")
LastRow = ToSheet.Range("A6536").End(xlUp).Row + 1
ToSheet.Paste Destination:=ToSheet.Range("A" & LastRow)
End Sub
'--------------------------------


---
Message posted from http://www.ExcelForum.com/