Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

4921 / 76735

←次へ　｜　前へ→


	【77429】Re:繰り返し　コピーペースト

YUKI - 15/10/1(木) 14:12 -


	引用なし

	パスワード

返信遅くなりまして申し訳ありません。

少し状況が変わりまして、
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

0 hits

▼

【77416】繰り返し　コピーペースト YUKI 15/9/25(金) 14:44