UsedRangeでそのシートで使用しているセル範囲が判りますので、For Eachでそのセル範囲をすべて見ていきます。
1行目、またはデータなしの時は処理なし、それ以外はSheet2のA列に列位置、B列に値を入れていきます。
最後にSheet1にソートをかけてお望みの並び方にして終了。
Sub Sample()
Dim rTarget As Range
Dim rOne As Range
Dim nPos As Long
Set rTarget = Sheets("Sheet1").UsedRange
With Sheets("Sheet2")
nPos = 1
For Each rOne In rTarget
If (rOne.Row <> 1) And (rOne.Value <> "") Then
.Cells(nPos, 1) = rOne.Column
.Cells(nPos, 2) = rOne.Value
nPos = nPos + 1
End If
Next rOne
If nPos > 1 Then
.Sort.SetRange Range("A1:B" & (nPos - 1))
.Sort.Header = xlNo
.Sort.Apply
End If
End With
End Sub
補足
ありがとうございます。 無事できました。 ソートに関しては、下記のような並びの規則で毎回行いたいのですが、マクロを走らせた時点でソートも反映させることはできないでしょうか? 1 aaa 1 bbb 1 ccc 2 abc 2 abcd 3 aaaa 3 bbbb 3 cccc 3 eeee