VBA 同じ値が複数回でてくる場合の転記

Question

以下の数式において、
データ移行シートのI列2-7行の間に同じ値が複数回ある場合があり、
その場合、この式ではうまく代入ができません。

データ移行シートI2のシートの値と同じシート名のシートの最終行に、データ移行シートのA2-D2,F2-G2の値を代入し、それをI2-I7まで繰り返すという作業です。
Iの値は、空白の場合もあり、エラーをスキップします。

今回、Iの値が、２行にわたり同じ値の場合もある際に、転記できるようにしたいです。
お力添えいただけますでしょうか？
よろしくお願いいたします。

Public Sub 転記回答②()
 Dim wrow As Long
 Dim ws1 As Worksheet   'データ移行シートI2の値のシートの最終行にA2:D2とF2：G2の値代入
Set ws1 = Sheets("データ移行") 

Dim ws2 As Worksheet
 For wrow = 2 To 7
 'エラーのセルはスキップする
If IsError(ws1.Cells(wrow, "I").Value) = False Then
 Set ws2 = Sheets(ws1.Cells(wrow, "I").Value) 

Dim TargetRng As Range
 Set TargetRng = ws2.Cells(Rows.Count, "A").End(xlUp).Offset(1) 

TargetRng.Resize(, 4).Value = ws1.Range("A2:D2").Value
 TargetRng.Resize(, 1).Offset(, 5).Value = ws1.Range("F2").Value
 End If
 Next 

End Sub 

コード

Comments

[m.ts10806]

コードはマークダウンのcode機能を利用してご提示ください。
https://teratail.com/help#about-markdown

[mi07]

初心者なので使い方を理解しておりませんでした。これで大丈夫でしようか？
よろしくお願いします。

[m.ts10806]

そうですね。大丈夫だと思います。
強いてなら下記のように冒頭は「言語名」も含めてもらえるとなお良しです（言語に則したコードハイライトがつくようになります。）
```VBA

[m.ts10806]

と思ったら冒頭にコードくっついてますね。
```VBA
コード
````

のように前はスペースなく詰めて、後ろは改行しておいてください。

[m.ts10806]

↑タイトルではなく提示されているコードの話です

[mi07]

おっしゃられたようにやったつもりですが…あってますでしょうか？

[m.ts10806]

回答がついたのでそれで解決できそうと思って見てるだけになっていました。失礼しました。
本当に細かいところを言うと「コード」という文字もなくていいです。
というか「実際のコードのみ」を提示するエリアだったりします。
右上の[[＋]ボタン押下でコピーができるのですが、それは「コピペですぐ回答者が再現できるように」という機能なので、実際のコードにない情報が入っているとそれが「コードにもともと入っているのか、削除忘れか」は他者には判断できないので。

[mi07]

なるほど、勉強になります。ありがとうございました！

Answer 1

質問の意味というか、実現したい要件がよくわかりませんでした。
teratailはわからない部分を質問するサイトですが、質問文中にわからないことが書かれていません。

あと、この質問を見た人間としては､質問者さんが以前質問していた内容というのがわかりませんので､そのURLを貼るなどされるほうが良いでしょう｡

こういうことかな？という推測でコードを書いています。
的外れでしたら無視してください。

Option Explicit

'データ移行シートI列の値と同じシート名の最終行にA:DとF:Gの値代入
Sub CopyDataSheet()
    
    Dim copyRow As Long         'コピー元の行番号
    Dim copySheet As Worksheet  'コピー元のシート
    Dim pasteRange As Range     '転記先のRangeオブジェクト
    Dim pasteSheet As Worksheet '転記先のシート

    Set copySheet = Sheets("データ移行")
    
    For copyRow = 2 To 7
        'エラーのセルはスキップする
        If IsError(copySheet.Cells(copyRow, "I").Value) = False Then
            Set pasteSheet = Sheets(copySheet.Cells(copyRow, "I").Value)
            Set pasteRange = pasteSheet.Cells(Rows.Count, "A").End(xlUp).Offset(1)
            pasteRange.Resize(, 4).Value = copySheet.Range(copySheet.Cells(copyRow, 1), copySheet.Cells(copyRow, 4)).Value
            pasteRange.Resize(, 1).Offset(, 5).Value = copySheet.Cells(copyRow, 6).Value
        End If
    Next

End Sub

変数名は変えさせてもらっていますが､見たら内容はわかると思います｡

コメントにはG列もコピーするようになっていますが、実際のコードはG列までコピーしないように見受けられます。
どちらが正解かわかりませんので、その部分はいじっていません。

Comments

[hatena19]

> ループする回数と同じだけ宣言されますが､それは無駄になります｡
Dim 宣言はどこに書いても1回しか評価されません。ループ内に書いてもです。
どこに書くかは好みもありますが、下記で議論されてますのでご参考に。
VBA - 見やすい 変数の 宣言位置｜teratail
https://teratail.com/questions/137797

[Secret]

ご指摘ありがとうございます。
良い勉強になりました。
不要な混乱を避けるために、上記の回答からは削除致します。

[mi07]

ありがとうございました。
日本語力不足で申し訳ありません。。。

[Secret]

それよりも、わからないことを明記するようにしてください。
動かなかった事象と実現してほしいことだけを記載しても、単なる作業依頼（しかも無料）と思われて回答はつきません。
今回、質問者さんも意図通り動かない事象を見てから、10分間なり24時間以上なり何かやろうとしたと思います。
（何もやろうとしなかったのでは、本当に作業依頼であり、それは業者にでも依頼してくださいという話になります）
何かやろうとした中で不明な点があったことを質問文に明記して、回答者がそれに応えることで理解に至れば、それで解決といえると思いますし、そういう場を提供しているのがteratailであるはずです。