No creo que puedas hacer lo que quieras. No hay forma (que yo sepa) de detectar solo pastas.
Lo más cercano es usar
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Pero esto significa que se activará cada vez que se realice algún cambio en la página.
Entonces, como solución, lo que puede hacer es pegar en Col Q y luego ejecutar manualmente una macro (que puede asignar a un botón si es más fácil).
Option Explicit
Sub MatchThePairs()
'You can edit this top bit
'The name of column you are pasting into
Dim pastedCol As String
pastedCol = "Q" 'UPDATE ME IF NEEDED
'The name of the look up column
Dim lookupCol As String
lookupCol = "Z" 'UPDATE ME IF NEEDED
'The name of the look to show results
Dim resultCol As String
resultCol = "AA" 'UPDATE ME IF NEEDED
'Do you want to clear the results first ?
Dim clearResults As Boolean
clearResults = True 'CHANGE ME TO True OR False
'What is the row of the header (if you have one)
Dim rowHeader As Integer
rowHeader = 1 ' set to 0 if no header
'What is the name of the results column
Dim resultsColHeader As String
resultsColHeader = "ResultsCol" ' Change me to what ever
'what is the first row (do not include the headings)
Dim row As Integer
row = 2 'AS PER THE SCEEN SHOT, I STARTED ON ROW 2
' **** hopefully you won't need to edit anything below this
If clearResults Then
Range(resultCol & ":" & resultCol).Cells.Clear
If rowHeader > 0 Then
Range(resultCol & rowHeader).Value = resultsColHeader
End If
End If
Do While (Range(pastedCol & row).Value <> "")
If Range(pastedCol & row).Value = Range(lookupCol & row).Value Then
'yipee, a match
Range(resultCol & row).Value = Range(lookupCol & row).Value
End If
row = row + 1
Loop
End Sub
antes de
Después