Function pr Dim As Worksheet Set wb_source Sheets Set wb_source Sheets

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Function pr()
Dim a, b As Worksheet
Set a = wb_source.Sheets(2)
Set b = wb_source.Sheets(3)
a.Range("A1:G" & a.UsedRange.Rows.Count).Copy
Dim temp As Integer
Dim res_sh As Worksheet
If sheetEmpty(wb_result.Sheets(wb_result.Sheets.Count)) Then
Set res_sh = wb_result.Sheets(wb_result.Sheets.Count)
Else
Set res_sh = wb_result.Sheets.Add
End If
res_sh.Range("A1").PasteSpecial
res_sh.Range("A1:G" & a.UsedRange.Rows.Count).Columns.AutoFit
For i = 2 To a.UsedRange.Rows.Count
On Error Resume Next
temp = WorksheetFunction.VLookup(Cells(i, 4), b.Range("A2:B" & b.UsedRange.Rows.Count), 2, 0)
On Error GoTo 0
If temp <> 0 Then
If Cells(i, 3) > temp Then
res_sh.Range("A" & i, "G" & i).Interior.ColorIndex = 34
res_sh.Cells(i, 3).Value = temp
End If
End If
temp = 0
Next i
End Function