|
Option Explicit
Sub TEST2()
Dim ar, i&, r&, Rng As Range, rngFind As Range
Application.ScreenUpdating = False
With Intersect(Columns("D:H"), ActiveSheet.UsedRange)
Set Rng = Intersect(.Offset(), .Offset(1))
End With
With Sheets(2)
r = .Cells(Rows.Count, "A").End(xlUp).Row
ar = .Range("A2:C" & r).Value
End With
For i = 1 To UBound(ar)
Set rngFind = Rng.Find(ar(i, 1), , , xlWhole)
If Not rngFind Is Nothing Then
Do
rngFind.Value = ar(i, 3)
Set rngFind = Rng.FindNext(rngFind)
Loop Until rngFind Is Nothing
End If
Next i
Set Rng = Nothing: Set rngFind = Nothing
Application.ScreenUpdating = True
Beep
End Sub
|
|