Change from Entirerow to Column range

Hi Experts,

I'm struck!!! I have below piece of code that copies entire row while copying from one worksheet to other. I need only selected column in row to be copied.

Any Help on same is really appreciated

Function FilterAndCopy(rng As Range, Choice As String)

Dim FiltRng As Range

Dim Aname As String
Aname = ActiveWorkbook.Sheets(1).Range("A1").Value
Workbooks.Add


'Clear Contents to show just new search data
Worksheets("Sheet1").Cells.ClearContents
'Set the column to filter (In This Case 1 or A)
'Change as required
rng.AutoFilter Field:=1, Criteria1:=Choice
On Error Resume Next
Set FiltRng = rng.SpecialCells(xlCellTypeVisible).EntireRow
On Error GoTo 0

'Copy Data across to sheet 2
FiltRng.Copy Worksheets("Sheet1").Range("A1")
'Display Data
Worksheets("Sheet1").Select
Range("A1").Select
Set FiltRng = Nothing

ActiveWorkbook.SaveAs fileName:=Aname & ".xls"
ActiveWorkbook.Close
End Function