VBAを使いシート間で貼り付け

「シート1」のC・E・I・O列の値を図のような配置で「シート3」に値で貼り付けたいです。

「シート1」のグループには空白がある場合があります。

「シート3」にはすでに項目が埋まっている場合があります、仮に5番まで埋まっていたら
次の6番に「シート1」の項目を追加していきたいです。

「シート1」が未入力の場合、そのまま空白を「シート3」の空き項目に値で貼り付けたいです。
「シート1」と同じフォーマットで入力済の「シート２」が存在した場合、同じマクロを実行したとき
「シート3」の空き項目に貼り付けたいからです。

グループに空白があるとどう貼り付ければ良いかわからなくなり、もう降参です。
お詳しい方教えてください、宜しくお願いいたします。

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

• すいません、言葉が足りていませんでした。
  シート2にも同じようなマクロを追加して実行したときに、シート3の空き項目に貼り付けることも想定しているというだけの事です。特に関係ありません、申し訳ないです。

  No.1の回答に寄せられた補足コメントです。 補足日時：2023/03/15 06:11

No.3 ベストアンサー 回答者： fujillin 回答日時： 2023/03/14 23:13

こんばんは

ご説明の内容がよく理解できないのですが、勝手に想像と空想で埋めて・・・

＞グループに空白があるとどう貼り付ければ良いかわからなくなり～
どうしたいのかよくわかりません。
空白だろうが空白でなかろうが、単純に転記するのではダメなのでしょうか？
以下は、単純に転記するだけの例です。（なさりたいこととは違うのかも知れませんが）

※ シートのレイアウトはご提示の添付図の通りと仮定
※ シート名は「シート1」、「シート3」と仮定

Sub Q_13390927()
Dim sh As Worksheet, rw As Long
Dim sRange As Range, dRange As Range

Set sh = Worksheets("シート1")
With Worksheets("シート3")
rw = .Cells(Rows.Count, 3).End(xlUp).Row + 1
rw = Application.Max(Int(rw / 2) * 2 + 1, 11)
Set dRange = .Cells(rw, 3).Resize(2, 5)
End With

For rw = 5 To sh.Cells(Rows.Count, 3).End(xlUp).Row
Set sRange = sh.Cells(rw, 3).Resize(1, 13)
dRange(1).Value = sRange(1).Value
dRange(3).Value = sRange(13).Value
dRange(5).Value = sRange(7).Value
dRange(6).Value = sRange(3).Value
Set dRange = dRange.Offset(2)
Next rw
End Sub

この回答へのお礼

私にとって完璧なご回答でした！ありがとうございます！

お礼日時：2023/03/15 19:31

No.2 回答者： Qchan1962 回答日時： 2023/03/14 23:12

こんばんは

要件が足りていないような・・・
＞「シート1」と同じフォーマットで入力済の「シート２」が存在した場合、
これはどういう事でしょうか・・・

「シート1」から「シート3」を作るだけならデータ全てを処理すれば良いけれど・・条件により出力したりしなかったりするのかな？
だとすると「シート1」の５行目だけを対象に「シート3」に追加すれば良いのでしょうか？

「シート1」の全データを対象に加工するのであれば　一例ですが下記の様な処理は参考になりますか

Sub test()
Dim dataRowCount As Long
Dim Ary()
Dim i As Long, n As Long
With Sheets("Sheet1")
dataRowCount = .Range("C5", .Cells(Rows.Count, "C").End(xlUp)).Rows.Count * 2
ReDim Ary(dataRowCount, 4)
For i = 5 To .Cells(Rows.Count, "C").End(xlUp).Row
Ary(n, 0) = .Cells(i, "C")
Ary(n, 2) = .Cells(i, "O")
Ary(n, 4) = .Cells(i, "I")
Ary(n + 1, 0) = "'" & .Cells(i, "E")
n = n + 2
Next
End With
Sheets("Sheet3").Range("C11").Resize(UBound(Ary, 1) + 1, UBound(Ary, 2) + 1).Value = Ary

End Sub

１行を出力する場合（あまり良い方法では無いかも）
Sub test_01()
Dim rng As Range
Dim n As Long
n = 5 '5行目を出力
Set rng = Sheets("Sheet3").Cells(Rows.Count, "C").End(xlUp).Offset(1)
With Sheets("Sheet1")
rng.Offset(, 0) = .Cells(n, "C")
rng.Offset(, 2) = .Cells(n, "O")
rng.Offset(, 4) = .Cells(n, "I")
rng.Offset(1, 0) = "'" & .Cells(n, "E")　'文字のようなので
End With
End Sub

'文字のようなので　これを実行すると　'　がセルに入力されます
入力されているので次の最終行が取得できます（文字列として扱われます）

この回答へのお礼

ありがとうございます！きちんと動作しました。

お礼日時：2023/03/15 19:32

No.1 回答者： tatsumaru77 回答日時： 2023/03/14 22:46

>「シート1」と同じフォーマットで入力済の「シート２」が存在した場合、>同じマクロを実行したとき

>「シート3」の空き項目に貼り付けたいからです。

この意味がよくわかりません。
提示されたマクロの機能は、シート１の内容をシート３に貼り付けかと思います。
シート２の内容をシート３に貼り付ける機能も、このマクロは持っているのですか？