Thanks for your reply,

I assume the exchange rate is in the original sheet. We can use PasteSpecial
for this task.

Sub CopySelectedColumns()
Dim wbA As Workbook
Dim CopyToWb As Workbook
Dim RateCell As Range
Set wbA = ThisWorkbook
SelectedCol = Range("P2").Value
fCol = Range("B1:N1").Find(what:=SelectedCol, _
Lookat:=xlWhole).Column

Set CopyToWb = Workbooks.Add
Set RateCell = wbA.Worksheets("Sheet1").Range("R2")

wbA.Worksheets("Sheet1").Columns(1).Copy _
CopyToWb.Worksheets("Sheet1").Range("A1")
wbA.Worksheets("Sheet1").Columns(fCol).Copy _
CopyToWb.Worksheets("Sheet1").Range("B1")
CopyToWb.Worksheets("Sheet1").Range("C1") = _
fOSUserName & ", " & Now()

Do
Customer = InputBox("Enter customer name", "Regards, PJ")
Loop Until Customer < ""
CopyToWb.Worksheets("Sheet1").Range("C2") = Customer

LastRow = CopyToWb.Worksheets("Sheet1").Range("B" &
Rows.Count).End(xlUp).Row

RateCell.Copy
CopyToWb.Worksheets("Sheet1").Range("B2:B" & LastRow).PasteSpecial _
Paste:=xlAll, Operation:=xlMultiply, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False

Do
SaveAsFileName = Application.GetSaveAsFilename _
(fileFilter:="Excel Files (*.xls), *.xls")
Loop Until SaveAsFileName < False

CopyToWb.SaveAs Filename:=SaveAsFileName
CopyToWb.Close 'Remove this line if the new workbook shall remain open
End Sub

Regards,
Per

"winnie123" skrev i meddelelsen
...
Thanks Per,

this works perfectly.

One more question if I may please.

Columns B to N are numeric (prices) I have added a data validation to
select
currency in Q2 and then I use a lookup formula in R2 to get the exchange
rate.

Could the exchange rate be used to be able to multiply the column
selected.

Eg

original price is £75.00, should end up ‚¬90.00 using exchange rate of 1.2


Thanks for your help

Winnie

"Per Jessen" wrote:

Hi Winnie

In cell P2 I created a validation list holding the Column Headings (Data

Validation Allow: List Source: =B1:N1) OK), and then I inserted a
CommandButton to call the macro "CopySelectedColumns"


Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Sub CopySelectedColumns()
Dim wbA As Workbook
Dim CopyToWb As Workbook
Set wbA = ThisWorkbook
SelectedCol = Range("P2").Value
fCol = Range("B1:N1").Find(what:=SelectedCol, _
Lookat:=xlWhole).Column

Set CopyToWb = Workbooks.Add
wbA.Worksheets("Sheet1").Columns(1).Copy _
CopyToWb.Worksheets("Sheet1").Range("A1")
wbA.Worksheets("Sheet1").Columns(fCol).Copy _
CopyToWb.Worksheets("Sheet1").Range("B1")
CopyToWb.Worksheets("Sheet1").Range("C1") = _
fOSUserName & ", " & Now()

Do
Customer = InputBox("Enter customer name", "Regargs, PJ")
Loop Until Customer < ""
CopyToWb.Worksheets("Sheet1").Range("C2") = Customer

Do
SaveAsFileName = Application.GetSaveAsFilename _
(fileFilter:="Excel Files (*.xls), *.xls")
Loop Until SaveAsFileName < False

CopyToWb.SaveAs Filename:=SaveAsFileName
CopyToWb.Close 'Remove this line if the new workbook shall remain open
End Sub

Function fOSUserName() As String
' Returns the network login name
Dim lngLen As Long, lngX As Long
Dim strUserName As String
strUserName = String$(254, 0)
lngLen = 255
lngX = apiGetUserName(strUserName, lngLen)
If (lngX 0) Then
fOSUserName = Left$(strUserName, lngLen - 1)
Else
fOSUserName = vbNullString
End If
End Function


Best regards,
Per

"winnie123" skrev i meddelelsen
...
I have a spreadsheet with columns A - N populated, at the moment there
are
89
rows of data text and numeric. The number of rows can change if new
items
are
added.

I would like to be able to select Col A and then another column of the
users
choice, copy the data to a new worksheet, keeping the original format.
so
eg
col A and Col F need to be copied into new w/b in Col A and Col B.
Even
better if I could use the heading from Col B to Col N for the user to
select
instead of Col F

I would then like the user ID, date and time to be entered into C1, the
name
of a customer in C2 ( could this be entered via an input box) and then
the
command file save as appear, so that the user can save the file.

Any ideas?

Thanks

Winnie