Code:
Sub MatchAndCopy()
Dim sheet01 As Worksheet, sheet02 As Worksheet
Dim c As Range, matchingCell As Long
Dim RangeInSheet1 As Range
Dim RangeInSheet2 As Range
Dim dict As Object, tmp
Set dict = CreateObject("scripting.dictionary")
Application.ScreenUpdating = False
Application.DisplayStatusBar = True
Set sheet01 = Worksheets("Sheet1")
Set sheet02 = Worksheets("Sheet2")
Set RangeInSheet1 = sheet01.Range(sheet01.Range("A2"), _
sheet01.Cells(Rows.count, 1).End(xlUp))
Set RangeInSheet2 = sheet02.Range(sheet02.Range("A2"), _
sheet02.Cells(Rows.count, 1).End(xlUp))
'populate dictionary...
For Each c In RangeInSheet1.Cells
tmp = c.Value
If Not dict.exists(tmp) Then
dict.Add tmp, c.Row
End If
Next c
For Each c In RangeInSheet2.Cells
tmp = c.Value
If dict.exists(tmp) Then
Application.StatusBar = "Please wait while data is being copied," & _
" Processing count : " & c.Row
sheet01.Cells(dict(tmp), "F").Resize(1, 5).Value = _
c.Offset(0, 1).Resize(1, 5).Value
End If
Next c
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub
Sub MatchAndCopy()
Dim sheet01 As Worksheet, sheet02 As Worksheet
Dim c As Range, matchingCell As Long
Dim RangeInSheet1 As Range
Dim RangeInSheet2 As Range
Dim dict As Object, tmp
Set dict = CreateObject("scripting.dictionary")
Application.ScreenUpdating = False
Application.DisplayStatusBar = True
Set sheet01 = Worksheets("Sheet1")
Set sheet02 = Worksheets("Sheet2")
Set RangeInSheet1 = sheet01.Range(sheet01.Range("A2"), _
sheet01.Cells(Rows.count, 1).End(xlUp))
Set RangeInSheet2 = sheet02.Range(sheet02.Range("A2"), _
sheet02.Cells(Rows.count, 1).End(xlUp))
'populate dictionary...
For Each c In RangeInSheet1.Cells
tmp = c.Value
If Not dict.exists(tmp) Then
dict.Add tmp, c.Row
End If
Next c
For Each c In RangeInSheet2.Cells
tmp = c.Value
If dict.exists(tmp) Then
Application.StatusBar = "Please wait while data is being copied," & _
" Processing count : " & c.Row
sheet01.Cells(dict(tmp), "F").Resize(1, 5).Value = _
c.Offset(0, 1).Resize(1, 5).Value
End If
Next c
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub