|
なんと、同時間にレスしたようですね。
で、
全然認識が違ったようですね。
ある特定範囲を各々空白セルを詰めるってことですか?
その特定範囲が固定で、
F3〜F24 F26〜F47
M3〜M24 M26〜M47
T3〜T24 T26〜T47
AA3〜AA24 AA26〜AA47
AH3〜AH24 AH26〜AH47
と限定されているのであれば、
簡単にやるんであれば、
私の最初のコードの"r"という範囲にその固定範囲を各々(For Eachループ)で
設定してやればよさそうですね。
Sub sample10()
Dim 対象範囲 As Range
Dim r As Range, c As Range
With ActiveSheet
Set 対象範囲 = Intersect(.Range("F:F,M:M,T:T,AA:AA,AH:AH"), .Range("3:24,26:47"))
End With
For Each r In 対象範囲.Areas
Debug.Print r.Address
r.EntireColumn.Insert xlShiftToRight
With r.Offset(, -1)
.Item(1).Value = 1
.DataSeries
On Error Resume Next
r.SpecialCells(xlCellTypeBlanks).Offset(, -1).ClearContents
On Error GoTo 0
.Resize(, 2).Sort Key1:=.Columns(1), Order1:=xlAscending, _
Header:=xlNo, Orientation:=xlTopToBottom
.EntireColumn.Delete xlShiftToLeft
End With
Next
End Sub
|
|