|
返信遅くなりまして申し訳ありません。
少し状況が変わりまして、
AEに纏めるデータはE4:S180へ(修正しました。)
AG〜BL(増減の可能性あり)の1〜180行のデータを
A1:180へ貼ってまとめ、元の列へ上書きとしたいです。
AE列を経由しなくても構いません
以下のコードを書きましたが、
繰り返しが上手くできず全列分このコードをVBAに書く事しかできませんでした。
現状動いてはいるのですが列の増減での修正が手間でしょうがありません。。。
よろしくお願いします
Dim r As Range
Dim col As Range
Dim pos As Range
Application.ScreenUpdating = False
'######AG
Range("AE2:AE5000").Clear
Range("AG1:AG180").Copy Range("A1:A180")
Set r = Range("E4:S180")
For Each col In r.Columns
If pos Is Nothing Then
Set pos = Range("AE4")
End If
pos.Resize(r.Rows.Count).Value = col.Value
Set pos = pos.Offset(r.Rows.Count)
Next
Range("AE1:AE5000").Sort _
Key1:=Range("AE1"), _
Order1:=xlAscending, _
Header:=xlYes, _
Orientation:=xlTopToBottom
Range("AG1:AG180").Value = Range("AE1:AE180").Value
'######AH
Range("AE2:AE5000").Clear
Range("AH1:AH180").Copy Range("A1:A180")
Set r = Range("E4:S180")
For Each col In r.Columns
If pos Is Nothing Then
Set pos = Range("AE4")
End If
pos.Resize(r.Rows.Count).Value = col.Value
Set pos = pos.Offset(r.Rows.Count)
Next
Range("AE1:AE5000").Sort _
Key1:=Range("AE1"), _
Order1:=xlAscending, _
Header:=xlYes, _
Orientation:=xlTopToBottom
Range("AH1:AH180").Value = Range("AE1:AE180").Value
|
|