VBA　条件一致・繰り返しコピー

前提・実現したいこと

初めまして　
条件に一致した行にあるセルを別シートへコピーする（振り分ける）コードを作成したいと考えています。
Sheet1の６行目以降にデータがあり、A行にある文字により、各シートの８行目移行へname2とname4を振り分けていきたいです。（name3はそのままです）
※下の画像（Sheet1)のname１にaaaがあったらSheet1のB列をシートaaa（上画像）のA列に、Sheet1のD列をシートaaaのB列へコピーしたいです。　（シート名などわかりにくくてすいません）
　
![]

該当のソースコード

Sub wS()

　Set ws1 = Worksheets("Sheet1")
　Set ws2 = Worksheets("aaaa")
　　j = 8
　For i = 6 To ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
　　f = ws1.Cells(i, 1).Value
　If f = "aaaa" Then
　　ws2.Cells(j, 1) = f

　End If

　　j = j + 1
　Next i
End Sub

こちらのコードはaaaシートのみ対応でテスト的に作成したものです。
⓵行が８行目以下そのままの感覚でコピーされてしまいます。
⓶また　name１とname３のみコピーという離れたセルのコピーも出来ていません

Sub Sample1()
  Dim i As Long, k As Long
  Dim wS As Worksheet
  Dim myFlg As Boolean
  Dim myAry
 　  myAry = Array("aaaa", "bbbb", "cccc")
      With Worksheets("Sheet1")
        For i = 6 To .Cells(Rows.Count, "A").End(xlUp).Row
          For k = 0 To UBound(myAry)
            If .Cells(i, "A") = myAry(k) Then
              myFlg = True
              Exit For
            End If
          Next k
            If myFlg = True Then
              Set wS = Worksheets(myAry(k))
                wS.Cells(Rows.Count, "A").End(xlUp).Offset(1) = .Cells(i, "B")
            End If
              myFlg = False
        Next i
      End With
End Sub

他サイトでもみて上記の物を作成してみましたが、目的が果たせずこちらに質問をさせて頂きました。
どうかお力をお貸し下さい。宜しくお願いします。

azzuro

2020/08/14 01:40

>A行にある文字により各シートの８行目移行へこのA行はA列のことでしょうか？また上の画像はどのシートを指していますか？どのシートの何をどこのシートのどのセルへどうしたいかをもう少し具体的に書いた方がいいと思います。

DreamTheater

2020/08/14 02:35

VBAコードはMarkdown表記してください。（インデントのないコードは読む気になりません）

mako1972

2020/08/14 06:00 編集

最近、多いのですが、くだらない条件ばっかならべて読む気になりません。サンプルなのだからA1とかA2スタートにすればいいと思うんですけどわからない質問者に限って、転記セルがどうでもいい場所からはじまるとか条件が明確でないとか、そもそもなんだかなーという。一意見なので。スルーでOK。

kuku.ku

2020/08/14 08:20

皆様多数のご指摘ありがとうございます。

行動規範の内容に同意します

回答1件

ベストアンサー

kuku.kuさんのコードを元にしています。
offsetを使うとかもっとスマートなコードの書き方もあるでしょうが
まずはシンプルなコードで動きを確認した方がいいでしょう。

Sheet1のD列をシートaaaのB列へコピーしたい

とありますが、C列の誤りと理解して記述しています。
また、Sheet1のA列の値と同じ名前のシートが存在する前提にしているので、
例外がある場合はエラーになります。
そのあたりは適宜修正してください。

vba
1Dim ws          As Worksheet
2Dim targetWs    As Worksheet
3Dim i           As Integer
4Dim n1          As String
5Dim n2          As Integer
6Dim n4          As Integer
7Dim rc          As Integer
8
9
10Set ws = Worksheets("Sheet1")
11
12For i = 6 To ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
13
14    'name1
15    n1 = ws.Cells(i, 1).Value
16    'name2
17    n2 = ws.Cells(i, 2).Value
18    'name4
19    n4 = ws.Cells(i, 3).Value
20    
21    '転記先シート
22    Set targetWs = Worksheets(n1)
23    '値をコピー
24    With targetWs
25        '転記先シートの最終行番号
26        rc = .Cells(Rows.Count, "A").End(xlUp).Row + 1
27        '転記先シートのA列にname2をコピー
28        .Cells(rc, 1) = n2
29        '転記先シートのD列にname4をコピー
30        .Cells(rc, 3) = n4
31    End With
32    
33Next i
34