別のシートに転記（同時に２列ずつ３列ずつ転記）

Question

【転記元】シート１

　　　　 　　　　 A　　　　B　　　　C　
１　日付　　　　　10/1 10/2 10/3←こちらの日付を３日ごとに更新していきます。
３日分終われば、B2に10/4,B3に10/5,B4に10/6という形で更新します。　　　　　　　　　　　　　　　　　　　　

２　個数　　　　　10 50 30←こちらの数字もその日の数値に変更していきます。

３　金額 1000 5000 3000←こちらの数字もその日の数値に変更していきます。

４　本日の返品数 0 5 1←こちらの数字もその日の数値に変更していきます。

【転記先】シート２

　　　　　　　　　　A　　 　B　　　　C　　　　D E
１日付 　　　　 10/1 10/2 10/3　　10/4　 10/5・・・・・←数値がすべての分入力してあります。

２売り上げ目標

３個数 10 50 30

４金額 1000 5000 3000

５達成率

６本日の返品数　　0 5 1

転記元シートの日付から
個数、金額、本日の返品数を転記先に移したいのですが、

①転記先の行がそのまま転記ではなく、転記先の日付の次は別の数式が記載があり、
次の行から２個の項目を転記。という感じで、飛び飛びで転記する場合
どのようにＶＢＡを組んだほうがよろしいでしょうか？

②また、こちらは、２日分ずつ、３日分ずつ転記したいと考えて
おります。

以前、こちらを教えていただいてて、こちらを活用しようと思って、作っておりましたが、なかなか
うまくいきませんでした。

Sub 登録()
Dim ThisSh As Worksheet
Dim ThisCh As Worksheet
Dim Col As Long
Dim Rws As Long

Set ThisSh = ThisWorkbook.Sheets("Sheet1")
Set ThisCh = ThisWorkbook.Sheets("Sheet2")

Col = ThisCh.Range("1:1").Find(What:=ThisSh.Range("B1").Value).Column

Rws = ThisCh.Range("A:A").Find(What:=ThisCh.Range("A2").Value).Row
ThisCh.Cells(Rws, Col).Value = ThisSh.Range("B2").Value

Rws = ThisCh.Range("A:A").Find(What:=ThisCh.Range("A3:A4").Value).Row
ThisCh.Cells(Rws, Col).Value = ThisSh.Range("B2:B3").Value

Rws = ThisCh.Range("A:A").Find(What:=ThisCh.Range("A4").Value).Row
ThisCh.Cells(Rws, Col).Value = ThisSh.Range("B6").Value

Set ThisSh = Nothing
Set ThisCh = Nothing

End Sub

こちらのRws～先の３つ分を３回繰り返して書き込めば
３列続けて転記できるということでよろしいでしょうか？

失礼いたしました。転記前のシートをおつけします。

転記前のシート

　　　　　　　　　　A　　 　B　　　　C　・・・・
１日付 　　　　 10/1 10/2 10/3

２売り上げ目標

３個数

４金額

５達成率

６本日の返品数　　

こちらの、日付は事前に入っておりまして、それ以外の転記元のデータを転記先に転記したいと考えております。
日付の並びは同じようになっております。

Comments

[hatena19]

【転記先】シート２ ですが、これは転記後の図ですよね。
転記前はどうなっているのですか。それも図示してもらえますか。

A列の項目名と、1行目の日付は入力済みで、それ以外の数値データを転記したいということでしょうか。

日付は入力済みの場合、転記元と転記先の日付の並びは同じですか。それとも異なりますか。

[sakura12]

こんにちは。すみません・・・
複雑な内容でもうしわけございません。

1行目のみ転記先は入力済でございます。
日付は、転記元と転記先は同じ並びとなっております。
よろしくお願い致します。

[hatena19]

> ②また、こちらは、２日分ずつ、３日分ずつ転記したいと考えております。

これについて、もう少し具体的に説明していただけますか。

単純に転記元の2行目、3行目を転記先の3行目、5行目に上書きコピー、
4行目を６行目に上書きコピーでいいように思いますが、
それではダメですか。

[sakura12]

こちらは、転記先、転記元の日付が一致しているところに、転記する形になります。
転記元のデータは、３日ごともしくは２日ごとに日付も変更となります。
日付下の数値も変更になります。
転記元の2.3.4行目を転記先の3.4.6行目に各日付ごとに転記していくように
したいと考えております。

[hatena19]

日付の並びが異なるということですかね。
図示されたものは同じなってますので、実際のものに近い形で図示してもらえますか。
「３日ごともしくは２日ごとに日付も変更となります。」というのも反映したものに修正してください。
図では1日毎に変更されているようですが。

[hatena19]

ひょっとすると、転記元は、2日分もしくは3日分をまとめて入力するということでしょうかね。
例えば、今日(10/6)なら3日前から前日までのデータを入力。

日付　　　10/3　　　10/4　　10/5
個数　　　10　　　　50　　　30
金額　　　1000　　　5000　　3000
本日の返品数　0　　　5　　　　1

[sakura12]

何度も大変申し訳ございません。ただいま修正を致しました。

すみません。伝え方がつたなく申し訳ございません。
よろしくお願い致します。

[sakura12]

その通りでございます。
３日分もしくは、２日分をまとめて入力するということですね。すみません。
内容間違いございません。

[hatena19]

質問の追記部分をみて理解できました。

[sakura12]

申し訳ございませんでした。よろしくお願い致します。

Answer 1

Sub 登録()
    Dim ThisSh As Worksheet
    Dim ThisCh As Worksheet   
    Set ThisSh = ThisWorkbook.Sheets("Sheet1")
    Set ThisCh = ThisWorkbook.Sheets("Sheet2")

    Dim i As Long, Col As Long
    '↓転記元の2列目から入力のある最終列まで繰り返し処理
    For i = 2 To ThisSh.Cells(1, Columns.Count).End(xlToLeft).Column
        '↓転記元と同じ日付の列番号を取得
        Col = Application.Match(ThisSh.Cells(1, i), ThisCh.Rows(1), 0)
        '転記元の2,3,4行の値を転記先の3,4,6行目に転記
        ThisCh.Cells(3, Col).Value = ThisSh.Cells(2, i).Value
        ThisCh.Cells(4, Col).Value = ThisSh.Cells(3, i).Value
        ThisCh.Cells(6, Col).Value = ThisSh.Cells(4, i).Value
    Next
End Sub

それぞれのコードの意味をコメントしてありますので、それを元にご理解ください。

Comments

[sakura12]

ありがとうございました！
ご丁寧に本当に感謝しております。
助かりました！