| 
    
     |  | ▼ごん さん: 
 既に設定して作業列のもう1つ右に新しい作業列ということですね。
 その部分のみを回答してもいいのですが、もとの作業列やソート領域の指定、
 作業列のクリア等々にも影響がでますので、老婆心かもしれませんが
 あちらでアップしたSample3をベースに要件を加えてみました。
 Sample3との差異には★印をつけてあります。
 
 Sub SampleX()
 Dim myA As Range
 Dim lCell As Range
 Dim z As Long
 
 Application.ScreenUpdating = False
 
 With ActiveSheet.UsedRange
 Set lCell = .Cells(.Cells.Count).Offset(, 2)  '★
 End With
 
 Set myA = Range("A3", lCell)
 
 With myA.Columns(myA.Columns.Count - 1)      '★
 .Formula = "=LEN(B3)"
 .Value = .Value
 End With
 
 With myA.Columns(myA.Columns.Count)        '★
 .Value = myA.Columns("C").Value
 End With
 
 myA.Sort Key1:=lCell, Order1:=xlAscending, Header:=xlNo '★
 
 'Key2を変更 ★
 myA.Sort Key1:=Columns("A"), Order1:=xlAscending, _
 Key2:=lCell.Offset(, -1), Order2:=xlAscending, _
 Key3:=Columns("B"), Order3:=xlAscending, _
 Header:=xlNo
 
 lCell.Offset(, -1).Resize(, 2).EntireColumn.ClearContents '★
 Set myA = Nothing
 Set lCell = Nothing
 
 Application.ScreenUpdating = True
 
 End Sub
 
 |  |