Я не верю, что ты можешь делать то, что хочешь. Нет способа (о котором я знаю) обнаружить только пасты.
Наиболее близким является использование
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Но это означает, что он срабатывает каждый раз, когда вносятся какие-либо изменения на странице.
Таким образом, в качестве обходного пути вы можете вставить в Col Q, а затем вручную запустить макрос (который можно назначить кнопке, если проще).
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
До
После