Sub test()
Dim rng As Range, x(), y()
Dim j As Integer, k As Integer, cfind As Range
Dim m As Integer, n As Integer
'j = 0
'k = 0
With Worksheets("sheet1")
m = .Range("a1").End(xlDown).Row
n = .Range("a2").End(xlToRight).Column
'MsgBox "m-1= " & m - 2 & " n-2=" & " " & n - 2
ReDim x(1 To m - 1, 1 To n - 1)
ReDim y(1 To m - 1, 1 To n - 1)
For j = 0 To 3
Set rng = Range(.Range("B2").Offset(j, k), .Range("B2").Offset(j, k).End(xlToRight))
'MsgBox rng.Address
For k = 0 To 4
x(j + 1, k + 1) = WorksheetFunction.Small(rng, k + 1)
Set cfind = rng.Cells.Find(what:=x(j + 1, k + 1), lookat:=xlWhole)
'MsgBox cfind.Address
y(j + 1, k + 1) = .Cells(1, cfind.Column)
'MsgBox x(j + 1, k + 1)
'MsgBox y(j + 1, k + 1)
Next
k = 0
Next
End With
With Worksheets("sheet2")
For j = 0 To 3
If j >= 4 Then GoTo line1
.Range("A2").Offset(j, 0) = Worksheets("sheet1").Range("a2").Offset(j, 0)
For k = 0 To 4
'MsgBox x(j + 1, k + 1)
'MsgBox .Range("B2").Offset(j, k * 2).Address
.Range("B2").Offset(j, k * 2) = x(j + 1, k + 1)
'MsgBox y(j + 1, k + 1)
'MsgBox .Range("B2").Offset(j, k * 2).Offset(0, 1).Address
.Range("B2").Offset(j, k * 2).Offset(0, 1) = y(j + 1, k + 1)
Next
Next
End With
line1:
End Sub