Copiar contenido de COMBOBOX manualmente

Pido de su valioso conocimiento, tengo una macro de lista desplegable, casi esta perfecta para mis necesidades, el hecho es que necesito copiar el contenido de la celda del texto aplicado por el COMBOBOX que la contiene de manera manual (CTRL+C) a otro archivo o documento.

El detalle es que al seleccionar la celda del COMBOBOX, hace Dropdown en automático y no deja copiar...

¿Hay manera de evitar esto? ¿Por ejemplo que la lista se muestre SOLO SI SE PRESIONA LA TECLA DE FLECHA ARRIBA o ABAJO?

Espero darme a entender.

Gracias de antemano

El código de la macro es el siguiente:

Option Explicit
'=================================================================================================
'=============== ADJUST THE CODE IN THIS PART: ===================================
'maximum number of rows displayed in the combobox
Private Const LN As Long = 100

'where the cursor go after leaving the combobox
' ofs1 = 1 means 1 row below
' ofs2 = 1 means 1 column to the right
Private Const ofs1 As Long = 0
Private Const ofs2 As Long = 1

' NOTE: you might adjust combobox property in Sub toShowCombobox()

'-------- Do not change this part --------------

Private vList
Private nFlag As Boolean
Private d As Object
Private xRange As Range
Private oldVal As String

Private Sub ComboBox1_LostFocus()
If ComboBox1.Visible = True Then ComboBox1.Visible = False

End Sub
Sub toShowCombobox()

Dim Target As Range
'make sure the focus is still on this sheet
Set Target = ActiveCell
'setting up combobox property, change to suit
If Target.MergeCells Then
With ComboBox1
.Height = Target.Height
.Width = Target.Width * Target.MergeArea.Columns.Count
.Top = Target.Top - 2
.Left = Target.Offset(0, 0).Left
.Font.Size = 14
.Visible = True
.Value = ""
.Activate
End With
Else
With ComboBox1
.Height = Target.Height + 15
.Width = Target.Width + 5
.Top = Target.Top - 2
.Left = Target.Offset(0, 0).Left
.Font.Size = 14
.Visible = True
.Value = ""
.Activate
End With
End If

End Sub

'=================================================================================================
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'If Target.Cells.CountLarge = 1 Then
vList = Empty
If isValid(Target) Then 'if activecell has data validation type 3
On Error GoTo skip
Set xRange = Evaluate(Target.Validation.Formula1)
Call toShowCombobox
Else
If ComboBox1.Visible = True Then ComboBox1.Visible = False
End If
'End If

Exit Sub
skip:
If ComboBox1.Visible = True Then ComboBox1.Visible = False

End Sub

Function isValid(f As Range) As Boolean
Dim v
On Error Resume Next
v = f.Validation.Type
On Error GoTo 0
isValid = v = 3
End Function

Private Sub ComboBox1_GotFocus()
Dim i As Long, x, c As Range, dar As Object
If xRange Is Nothing Then ActiveCell.Activate: Exit Sub

With ComboBox1
.MatchEntry = fmMatchEntryNone
.Value = ""
Set dar = CreateObject("System.Collections.ArrayList")
Set d = CreateObject("scripting.dictionary"): d.CompareMode = vbTextCompare
vList = xRange.Value
For Each x In vList
d(CStr(x)) = Empty
Next
If d.Exists("") Then d.Remove ""
For Each x In d.keys
dar.Add x
Next
dar.Sort
'vList becomes unique, sorted & has no blank
vList = dar.Toarray()
.List = toList(vList)
.DropDown
dar.Clear: d.RemoveAll

End With

End Sub

Function toList(va As Variant)
Dim xList
If UBound(va) >= LN Then
ReDim xList(0 To UBound(va))
xList = va
ReDim Preserve xList(0 To LN - 1)
toList = xList
Application.StatusBar = "Items found: " & UBound(va) + 1 & ", displayed only: " & LN & " items"
Else
toList = va
Application.StatusBar = "Items found: " & UBound(va) + 1
End If

End Function
Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim cv, fm
Dim c As Range
nFlag = False
With ComboBox1

Select Case KeyCode
Case 13, 9 'Enter, Tab
cv = .Value
fm = Application.Match(cv, vList, 0)
If IsNumeric(fm) Then
Application.EnableEvents = False
ActiveCell = cv 'inserting combobox value to the active cell
ComboBox1.Visible = False
Application.EnableEvents = True
ActiveCell.Offset(ofs1, ofs2).Activate
Else
If Len(cv) = 0 Then
Application.EnableEvents = False
ActiveCell = "" 'delete the active cell content
Application.EnableEvents = True
Else
MsgBox "ERROR, Selección no válida", vbCritical
End If
End If

Application.StatusBar = Empty
Case 27 ', 9 'esc 'tab --> to leave combobox without inserting value to the active cell
.Clear
ActiveCell.Offset(ofs1, ofs2).Activate
Application.StatusBar = Empty
Case vbKeyDown, vbKeyUp
nFlag = True 'don't change the list when combobox1 value is changed by DOWN ARROW or UP ARROW key
Case Else
'do nothing
End Select
End With
End Sub

Private Sub ComboBox1_Change()

If nFlag = True Then Exit Sub

With ComboBox1
If Trim(.Value) = Trim(oldVal) Then Exit Sub
If .Value <> "" Then
Call get_filterX 'search without keyword order
.List = toList(d.keys)
.DropDown

Else 'if combobox1 is empty then get the whole list
On Error Resume Next
.List = toList(vList)
On Error GoTo 0
End If

nFlag = False
oldVal = Trim(.Value)
End With

End Sub

Sub get_filterX()
'search without keyword order
Dim i As Long, x, z, q
Dim v As String
Dim flag As Boolean
d.RemoveAll
z = Split(UCase(ComboBox1.Value), " ")

For Each x In vList
flag = True: v = UCase(x)
For Each q In z
If InStr(1, v, q, vbBinaryCompare) = 0 Then flag = False: Exit For
Next
If flag = True Then d(x) = Empty
Next

End Sub

Sub get_filterY()
'search with keyword order
Dim x
Dim tx As String
d.RemoveAll
tx = UCase("*" & Replace((ComboBox1.Value), " ", "*") & "*")
For Each x In vList
If UCase(x) Like tx Then d(x) = Empty
Next

End Sub

Sub toEnable()
Application.EnableEvents = True
End Sub