copy selected columns to a new spreadsheet....help

[dunk]

I need advice on the following problem....
I have an excel sheet with approx 20 columns, I need to select approx 10 of these columns and copy them into a new spreadsheet of the same column headings. Can i do this using VB if possible.
Any advise will be greatfull
dunk

[Brian]

Just change SourceSheet, ColumnsToCopyList, DestinationSheet values to match your spreadsheet.

This will copy all of the columns listed in the ColumnsToCopyList from SourceSheet to DestinationSheet, so that they are in the order of the ColumnsToCopyList.

'Option Explicit
Sub CopyColumnsInList()
'2002-05-15: Created by Brian West

' Source Sheet Info.
SourceSheet = "Source"
TitleRow = 1

' Columns To Copy List
Set ColumnsToCopyList = Worksheets("Lists").Range("A2:A65536")

' Destination Sheet Info.
DestinationSheet = "Destination"
DestinationColumn = 1

' Loop through each cell in the Columns to Copy List
For Each cell In ColumnsToCopyList
If IsEmpty(cell) Then Exit Sub 'Stop at the first blank cell
SearchTitle = cell.Value
SourceColumn = Application.WorksheetFunction.Match(SearchTitle, Worksheets(SourceSheet).Rows(TitleRow), 0)
Worksheets("Source").Columns(SourceColumn).Copy _
Destination:=Worksheets(DestinationSheet).Columns(DestinationColumn)
DestinationColumn = DestinationColumn + 1
Next cell

End Sub

[dunk]

Hi again.

Ive tried copying the code and I must still be missing something.
My workbook is called "Lists"
My source is called "S"
My destination is called "D"
The colums i would like copied over are colums titles "Ten", "Six" & "Four"
so my code looks like this

Sub CopyColumnsInList()
'2002-05-15: Created by Brian West

' Source Sheet Info.
SourceSheet = "S"
TitleRow = 1

' Columns To Copy List
Set ColumnsToCopyList = Worksheets("Lists").Range("A2:A65536")

' Destination Sheet Info.
DestinationSheet = "D"
DestinationColumn = 1

' Loop through each cell in the Columns to Copy List
For Each cell In ColumnsToCopyList
If IsEmpty(cell) Then Exit Sub 'Stop at the first blank cell
SearchTitle = cell.Value
SourceColumn = Application.WorksheetFunction.Match(SearchTitle, Worksheets(SourceSheet).Rows(TitleRow), 0)
Worksheets("Source").Columns(SourceColumn).Copy _
Destination:=Worksheets(DestinationSheet).Columns(DestinationColumn)
DestinationColumn = DestinationColumn + 1
Next cell

End Sub

I think its a problem with my variables im putting in?
Any help would be extremely welcome