[COLOR=BLUE]Sub[/COLOR] test()
Application.ScreenUpdating = [COLOR=BLUE]False[/COLOR]
[COLOR=BLUE]With[/COLOR] Sheets("Sheet2")
.Cells.Delete
Sheets("Sheet1").Range("A1:G50").Copy .Range("A1")
.Columns.AutoFit
[COLOR=BLUE]For[/COLOR] i = 2 [COLOR=BLUE]To[/COLOR] 32
[COLOR=BLUE]For[/COLOR] j = 2 [COLOR=BLUE]To[/COLOR] 7
[COLOR=BLUE]Set[/COLOR] temp = .Range("A34:A50").Cells.Find(What:=.Cells(i, j).Value)
[COLOR=BLUE]If Not[/COLOR] temp [COLOR=BLUE]Is Nothing Then[/COLOR] Var = Var + 1
[COLOR=BLUE]Next[/COLOR] j
.Cells(i, 8) = Var
Var = 0
[COLOR=BLUE]Next[/COLOR] i
.Range("A1:H32").Sort Key1:=.Range("H1"), Order1:=xlDescending, Header:=xlGuess
.Columns("H:H").ClearContents
.Activate
[COLOR=BLUE]End With[/COLOR]
Application.ScreenUpdating = [COLOR=BLUE]True[/COLOR]
[COLOR=BLUE]End Sub[/COLOR]