Sub kpark91July21()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Dim LR1&, LR2&, count&, dataWS1 As Worksheet, dataWS2 As Worksheet, i&, j&, destWS As Worksheet
Set dataWS1 = ThisWorkbook.Worksheets("Sheet 1")
Set dataWS2 = ThisWorkbook.Worksheets("Sheet 2")
Set destWS = ThisWorkbook.Worksheets("Sheet 3")
LR1 = dataWS1.Range("A" & Rows.count).End(xlUp).Row
LR2 = dataWS2.Range("A" & Rows.count).End(xlUp).Row
concatenateABC dataWS1, LR1, dataWS2, LR2
count = 1
For j = 1 To LR2
For i = 1 To LR1
If dataWS2.Range("D" & j).Value = dataWS1.Range("D" & i).Value Then
dataWS2.Range("A" & j & ":C" & j).Copy destWS.Range("A" & count)
count = count + 1
End If
Next i
Next j
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub
Function concatenateABC(dataWS1 As Worksheet, LR1 As Long, dataWS2 As Worksheet, LR2 As Long)
Dim i&
For i = 1 To LR1
dataWS1.Range("D" & i).Value = dataWS1.Range("A" & i).Value _
& dataWS1.Range("B" & i).Value _
& dataWS1.Range("C" & i).Value
Next i
For i = 1 To LR2
dataWS2.Range("D" & i).Value = dataWS2.Range("A" & i).Value _
& dataWS2.Range("B" & i).Value _
& dataWS2.Range("C" & i).Value
Next i
Set dataWS1 = Nothing
Set dataWS2 = Nothing
End Function
ffice
></o
