|
▼YUKI さん:
要件の誤解あれば指摘ください。
Sub Test2()
Dim myA As Range
Dim myC As Range
Dim r As Range
Dim col As Range
Dim pos As Range
Application.ScreenUpdating = False
Set myA = Range("AG1:BL180") '列数が増減あればここを変更
Set r = Range("E4:S180") '関数で生成される領域
For Each myC In myA.Columns 'mya から 列単位で変数 myc に取出し
Range("A1").Resize(myA.Rows.Count).Value = myC.Value
myC.EntireColumn.ClearContents
Set pos = Nothing
For Each col In r.Columns
If pos Is Nothing Then
Set pos = myC.Cells(1)
End If
pos.Resize(r.Rows.Count).Value = col.Value
Set pos = pos.Offset(r.Rows.Count)
Next
myC.Resize(Cells(Rows.Count, myC.Column).End(xlUp).Row).Sort Key1:=myC.Cells(1), Header:=xlYes
Next
End Sub
|
|