Excelのコピペ自動化

お恥ずかしいのですが

Excelファイル１のR2をコピーしExcelファイル2のA2へ貼り付け。
Excelファイル１のT2,V2,X2,Z2.......BA2をコピーしExcelファイル2のB2,B4,B6,B8.....へ貼り付け。
続いてExcelファイル１のU2,W2,Y2....CC2をコピーしExcelファイル2のB3,B5,B7,B9.....へ貼り付けの作業をマクロで組みたいのですがどなたか教えてください。

質問者からの補足コメント

• 回答ありがとうございます。
  やりたい事ができました。
  また、可能でしたら、1行ずつ繰り返し行う場合にはどうすればいいのでしょうか。
  for〜nextを自分なりに試したのですが上手くできませんでした。

  No.1の回答に寄せられた補足コメントです。 補足日時：2020/03/14 08:19

• 

  ご連絡頂きありがとうございます。
  かつ何度も申し訳ございません。
  
  お教え頂いた作業が完了するとsheet１のR3をコピーしsheet2のB64へ貼り付け。
  sheet１のT3,V3,X3,Z3.......CB3をコピーしsheet2のB64,B66,B67,B68.....へ貼り付け。
  続いてExcelファイル１のU3,W3,Y3....CC3をコピーしExcelファイル2のB65,B67,B68,B69.....へ貼り付けの作業を繰り返し行いたいと考えておりました。
  
  お教えいただいたデータを自分で少し手を加えてみたのですが、sheet１のR3のデータはsheet2のA3へ貼り付けられ、T2以降のデータはコピぺできない状態となりました。
  
  プログラム自体ネットで調べながら意味を少しでも理解しようと進めているのですが、なかなか思うように進みません。

  No.2の回答に寄せられた補足コメントです。 補足日時：2020/03/15 17:28

• 

  ありがとうございます。
  ほぼ思っていた内容通りの実行になってます。
  CC列までのデータをコピペしたいので、
  For j = Range("T1").Column To Range("CB1").Columnを
  For j = Range("T1").Column To Range("CC1").Column変更してみたのですが、
  変化がございません。
  どこを修正すれば変更できるのでしょうか。

  No.3の回答に寄せられた補足コメントです。 補足日時：2020/03/15 22:03

No.4 回答者： tom04 回答日時： 2020/03/15 22:24

＞CC列までのデータをコピペしたいので・・・

ん？質問文を拝見すると
BA列まではすべての列を表示し、それ以降は偶数列だけの表示ですよね？
CC列は63列目なので、奇数列になります。
すなわち、CC列までではなく、CD列をループさせないとお望みの結果にならないのでは？

そして、1列増えるというコトはSheet2のA列にSheet1のR列を表示するようにしていますが、
2行ずれるのでは？
すなわち　A64にR3ではなく　A66にR3になる。

とりあえず
＞cnt = (i - 2) * 62 + 2
　　↓
＞cnt = (i - 2) * 64 + 2

＞For j = Range("T1").Column To Range("CB1").Columnを
　　↓
＞For j = Range("T1").Column To Range("CD1").Column

に変更したらどうなりますか？m(_ _)m

この回答へのお礼

全てのセルに通し番号を入力してためしたところBA1以降のBB1,BD1・・・のデータが反映されていないようでしたので下記の様に変更するとデータのコピペができました。

For j = Range("T1").Column To Range("CB1").Column
　→For j = Range("T1").Column To Range("CC1").Column
If j <= Range("BA1").Column Then
　→ If j <= Range("cc1").Column Then

ありがとうございます。
Ｒ列もデータに相違がないか確認を行います。

お礼日時：2020/03/15 23:10

No.3 回答者： tom04 回答日時： 2020/03/15 20:59

続けてお邪魔します。

補足文ではSheet1の2・3行目だけの操作になっていますが。
とりあえずR2以降、R列のデータ最終行までの処理にしてみました。

Sub Sample3()
　Dim i As Long, j As Long, cnt As Long
　Dim wS As Worksheet
　　Set wS = Worksheets("Sheet2")
　　　'//▼Sheet2のA・B列を一旦消去★//
　　　wS.Range("A:B").ClearContents

　　　With Worksheets("Sheet1")
　　　　For i = 2 To .Cells(Rows.Count, "R").End(xlUp).Row
　　　　　cnt = (i - 2) * 62 + 2
　　　　　wS.Cells(cnt, "A") = .Cells(i, "R")
　　　　　For j = Range("T1").Column To Range("CB1").Column
　　　　　　If j <= Range("BA1").Column Then
　　　　　　　wS.Cells(cnt, "B") = .Cells(i, j)
　　　　　　Else
　　　　　　　If j Mod 2 = 0 Then
　　　　　　　　wS.Cells(cnt, "B") = .Cells(i, j)
　　　　　　　End If
　　　　　　End If
　　　　　　cnt = cnt + 1
　　　　　Next j
　　　　Next i
　　　End With
End Sub

※　マクロ実行時に一旦Sheet2のA・B列を消去するようにしています。
消去が不要であれば、★と次の行の2行を消してください。m(_ _)m

この回答へのお礼

何度も丁寧に対応頂きありがとうございます。
自分で自分で調べては試しているのですが、なかなか思うように進まなく困っていたところでした。

お礼日時：2020/03/15 22:05

No.2 回答者： tom04 回答日時： 2020/03/14 09:07

No.1です。

一気に2セルずつではなく、1セルずつ操作したい！というコトでしょうか？
そうであれば・・・

Sub Sample2()
　Dim j As Long, cnt As Long
　Dim wS As Worksheet
　　Set wS = Worksheets("Sheet2")
　　　With Worksheets("Sheet1")
　　　　wS.Range("A2") = .Range("R2")
　　　　　cnt = 1
　　　　　For j = Range("T1").Column To Range("CB1").Column
　　　　　　cnt = cnt + 1
　　　　　　　If j < Range("BA1").Column Then
　　　　　　　　wS.Cells(cnt, "B") = .Cells(2, j)
　　　　　　　Else
　　　　　　　　If j Mod 2 = 0 Then
　　　　　　　　　wS.Cells(cnt, "B") = .Cells(2, j)
　　　　　　　　End If
　　　　　　　End If
　　　　　Next j
　　　End With
End Sub

こんな感じではどうでしょうか？m(_ _)m

No.1 回答者： tom04 回答日時： 2020/03/13 23:04

こんばんは！

こちらのカテゴリではなかなか回答が付きにくいと思います。
（Excelなどのカテゴリの方が良いかも）

＞Excelファイル１　→　Sheet1　
＞Excelファイル2　→　Sheet2
とします。
（別ブックの場合は結構面倒になります）

尚、質問文通りにT2～BA2　と　U2～CC2　では列数が異なりますが、
CC列まですべての列ではなく、BA列より後は1列飛びでよいのですかね？

一例です。標準モジュールにしてください。

Sub Sample1()
　Dim j As Long, cnt As Long
　Dim wS As Worksheet
　　Set wS = Worksheets("Sheet2")
　　　With Worksheets("Sheet1")
　　　　wS.Range("A2") = .Range("R2")
　　　　　For j = Range("T1").Column To Range("CB1").Column Step 2
　　　　　　cnt = cnt + 2
　　　　　　　If j < Range("BA1").Column Then
　　　　　　　　wS.Cells(cnt, "B").Resize(2).Value = Application.Transpose(.Cells(2, j).Resize(, 2).Value)
　　　　　　　Else
　　　　　　　　wS.Cells(cnt, "B") = .Cells(2, j)
　　　　　　　End If
　　　　　Next j
　　　End With
End Sub

※　コピー＆ペーストではなく、値だけの操作にしています。

こんな感じではどうでしょうか？m(_ _)m