[OCN光]Twitterキャンペーン開催中!

VBA入門者です。宜しくお願いします。

以下の作業を、シート(1)~(3)に繰り返したいのです

 
 ◎シート(”レポート”)列A,C,F…40列まで3列置きにコピー
 ◎シート(1)のA3に貼付

初歩的な構文だとシートごとに設定するのが大変です(汗)
下の構文をコンパクトにまとめ、
できれば・・・
シート(2)には(B4,B23)~、シート(3)には(C4,C23)~同じ流れでコピペする動作も
まとめたいのです。

  With Worksheets("レポート")

.Range("A4:A23").Copy
Worksheets("1").Range("A3").PasteSpecial xlPasteValues

.Range("C4:C23").Copy
Worksheets("1").Range("B3").PasteSpecial xlPasteValues

.Range("F4:F23").Copy
Worksheets("1").Range("C3").PasteSpecial xlPasteValues

.Range("I4:I23").Copy
Worksheets("1").Range("D3").PasteSpecial xlPasteValues

'……40列まで続く
End With

教えて!goo グレード

A 回答 (1件)

こんにちは!



>'……40列まで続く
とは「レポート」Sheetの40列(AN列)までというコトでしょうか?
それともデータがある限り3列毎に40回同じ操作を繰り返す!というコトなのでしょうか?
質問文では
A・C・F・I・・・
となっていますので、
A列はそのまま値をコピー&ペーストし、C列以降3列毎というコトですよね?

二つやってみました。
「Sample1」がAN列までで、「Sample2」がデータがある限りC列以降3列毎に40回コピー&ペーストしています。

Sub Sample1()
Dim j As Long, cnt As Long, wS As Worksheet
Set wS = Worksheets("1")
With Worksheets("レポート")
.Range("A4:A23").Copy
wS.Range("A3").PasteSpecial Paste:=xlPasteValues
cnt = 1
For j = 3 To 40 Step 3 '//C列~AN列まで3列毎
cnt = cnt + 1
Range(.Cells(4, j), .Cells(23, j)).Copy
wS.Cells(3, cnt).PasteSpecial Paste:=xlPasteValues
Next j
End With
End Sub

Sub Sample2()
Dim j As Long, cnt As Long, wS As Worksheet
Set wS = Worksheets("1")
With Worksheets("レポート")
.Range("A4:A23").Copy
wS.Range("A3").PasteSpecial Paste:=xlPasteValues
For j = 3 To .UsedRange.Columns.Count Step 3 '//C列~最終列まで3列毎
If cnt = 40 Then Exit For '//40回繰り返したらループから抜ける★
cnt = cnt + 1
Range(.Cells(4, j), .Cells(23, j)).Copy
wS.Cells(3, cnt + 1).PasteSpecial Paste:=xlPasteValues
Next j
End With
End Sub

こんな感じで良いのでしょうか?m(_ _)m
    • good
    • 0
この回答へのお礼

tom04さんへ

ありがとうございます!!
【Sample1】を参考にさせていただきました!
本当に助かりました!
これで、上手く行きそうです!
感謝♡

お礼日時:2015/06/10 17:02

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

教えて!goo グレード

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング