質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

コピー

元のオブジェクトを破壊することなく、オブジェクトの複製を生成することをコピーと呼びます。

Q&A

解決済

1回答

4209閲覧

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

kuku.ku

総合スコア1

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

コピー

元のオブジェクトを破壊することなく、オブジェクトの複製を生成することをコピーと呼びます。

0グッド

0クリップ

投稿2020/08/14 01:17

編集2020/08/14 05:37

前提・実現したいこと

初めまして 
条件に一致した行にあるセルを別シートへコピーする(振り分ける)コードを作成したいと考えています。
Sheet1の6行目以降にデータがあり、A行にある文字により、各シートの8行目移行へname2とname4を振り分けていきたいです。(name3はそのままです)
※下の画像(Sheet1)のname1に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シートのみ対応でテスト的に作成したものです。
⓵行が8行目以下そのままの感覚でコピーされてしまいます。
⓶また name1とname3のみコピーという離れたセルのコピーも出来ていません

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

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

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

azzuro

2020/08/14 01:40

>A行にある文字により各シートの8行目移行へ この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

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

回答1

0

ベストアンサー

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

投稿2020/08/14 06:30

azzuro

総合スコア53

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

kuku.ku

2020/08/14 08:23

ご丁寧にコードの記載までありがとうございます。 ほぼやりたいことに近づいたのでベストアンサーとさせていただきます。 転記先へのコピー位置ですが、転記先シートの8行目以降へ転記をしたいと思います。 自身でも取り組んでみますがこちらを解決できるようでしたらお願いたします。
azzuro

2020/08/17 00:55

> rc = .Cells(Rows.Count, "A").End(xlUp).Row + 1 としているので8行目から転記がスタートするはずですがしませんか?
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問