Anne,
Something along this line will do what You want:
(I?ve added some checks as well as errorhandling)
'Add this line after You have connected the procedure to the button.
Option Private Module
Option Explicit
Sub GetAddy()
Dim rnData As Range, rnArea As Range, rnSelect As Range, rnCopy As Range
Dim stData As String
Dim vaData As Variant
Dim lnRow As Long, i As Long
On Error GoTo HandleErr
Application.ScreenUpdating = False
Set rnSelect = Selection
Set rnArea = Range("A1:E4")
Set rnCopy = Range("IV1:IV3")
rnCopy.ClearContents
If Not Application.Intersect(rnSelect, rnArea) Is Nothing Then
With rnSelect
If Not .Rows.Count > 1 Then
lnRow = .Row
Else
MsgBox "You should only select one row!", vbInformation
GoTo ExitHere
End If
End With
Else
MsgBox "You must select a cell in the coloured area!", vbInformation
GoTo ExitHere
End If
Set rnData = Range("A" & lnRow & ":" & "E" & lnRow)
vaData = Application.Transpose(rnData.Value)
For i = 1 To 2
rnCopy(i, 1).Value = vaData(i, 1)
Next i
For i = 3 To 5
If i = 5 Then
stData = stData & vaData(i, 1)
Else
stData = stData & vaData(i, 1) & ","
End If
Next
rnCopy(3, 1).Value = stData
'Put it into the clipboard.
rnCopy.Copy
MsgBox "You may switch to MS Word and paste it in!", vbInformation
ExitHere:
Application.ScreenUpdating = False
Exit Sub
HandleErr:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Module1.GetAddy"
Resume ExitHere
End Sub
Kind regards,
Dennis