| 
    
     |  | ▼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
 
 |  |