【Excel VBA】指定されたシートに該当のデータをコピーする

質問

Excel2003を使用しています。

あるセルに入力されている値と同じ名前のシートに、そのセルと同行のデータをコピーするというマクロを作成したいのですが。。。

例えば、Sheet1のC4セルに「１２３４」(文字列です)と入力されていたら、「１２３４」シートに、Sheet1のC4セルと同行のデータを貼り付け、Sheet1のC5セルに「１２３５」と入力されていたら、「１２３５」シートに、Sheet1のC5セルと同行のデータを貼り付け…といった感じで、Sheet1のC列(C4セル以下)に入力されている値を元に、それぞれのシートへ順番にデータをコピーしたいのです。

うまく表現できなくて、わかりづらいと思いますが、都度補足させていただきますので、よろしくお願いします。

回答No.9

Wendy02 · ベストアンサー

こんばんは。

もし、分かりにくかったら、サブルーチンでよいとは思うのですが、

>Sheet1の4行目C列検索→M列検索、5行目C列検索→M列検索、6行目C列検索→M列検索…というふうに、行ごとに検索して指定のシートへコピペされると思っていたのですが

考え方に間違いないです。でも、今回のは、単にコード自体の紛らわしさというか、見にくいコードだったからではないでしょうか？こういうのは、慣れとかだけの問題ではないでしょうか？究極的には、きれいに並べるという作業そのものではないかと思います。

ちゃんと試されているわけではないので、うまく行くかは分かりませんが、考え方をそのまま表現すると、こんな風に出来ると思います。ただし、i,j の部分は、ちょっと不安は残ります。

'標準モジュール

Sub TestMacro()
Dim n As Long
Dim i As Long
Dim j As Long

　Worksheets("Sheet1").Activate
　　For n = 4 To Cells(Rows.Count, 2).End(xlUp).Row
　　　　If Cells(n, 3).Value <> "" Then
　　　　　　With Worksheets(CStr(Cells(n, 3).Value))
　　　　　　　　i = .Cells(Rows.Count, 3).End(xlUp).Row + 1
　　　　　　　　Cells(n, 12).Resize(, 3).Copy .Cells(i, 2)
　　　　　　　　Cells(n, 7).Resize(, 1).Copy .Cells(i, 5)
　　　　　　　　Cells(n, 9).Resize(, 3).Copy .Cells(i, 9)
　　　　　　End With
　　　　End If
　　　　If Cells(n, 13).Value <> "" Then
　　　　　　With Worksheets(CStr(Cells(n, 13).Value))
　　　　　　　　j = .Cells(Rows.Count, 2).End(xlUp).Row + 1
　　　　　　　　Cells(n, 2).Resize(, 3).Copy .Cells(j, 2)
　　　　　　　　Cells(n, 17).Copy .Cells(j, 5)
　　　　　　　　Cells(n, 18).Copy .Cells(j, 7)
　　　　　　　　Cells(n, 19).Resize(, 3).Copy .Cells(j, 9)
　　　　　　 End With
　　　　 End If
　　Next n
End Sub

お礼

Wendy02 さん、おはようございます。
お礼が遅くなり、申し訳ありません。

教えていただいたコードで、うまくいきました。
先の回答でもコードの書き方を教えていただいていましたので、それを真似て同じように書いていたつもりなのですが、Wendy02 さんのおっしゃるように、“慣れ”なのでしょうね。

今回も、最後までお付き合いくださり、大変助かりました。
やりたいこととしては、これで第一段階が済んだところといった感じでしょうか…。
またお世話になるかもしれませんが、そのときはよろしくお願いします(^^ゞ

回答No.8

Wendy02

こんにちは。

>最終的には、C列に入力されている値を元に、それぞれのシートへデータをコピーするという同様の作業を、M列に入力されている値を元にしてもやりたいのですが、検索する列が複数でも可能なのでしょうか？

もちろんです。セルの配置を実際のシートで試してみましたが、拾った値でエラーさえでなければ、根本的に変える必要がないような気もしますね。後は、C列、M列は、合わせてしまってよいと思います。

私自身の立場でも、単に、マクロ実行中のエラーを防ぐためのエラー処理を施すだけで、基本的には同じスタイルにすると思いますね。

ただ、確か、実行時には、Sheet1 で動かしていたはずですね。そうすると、Sheet1 を指名するという必要はないように思うのですが、うまくいかなかったでしょうか？

必要なら、With Worksheets("Sheet1") のステートメントでくくってしまえば、良いと思います。いっそ、Sheets("Sheet1").Cells(Rw2, 13).Value　は、変数にしておいてしまえば、もっと短くて、見やすくなるというか、ただ、それだけの話ですが。（分かりきったことを言ってすみません。）

それと、連続するセルの場合は、Resize を使って、Cells(Rw1, 9).Resize(,3) で、３セルを横に取得できます。そうすると、そのメリットは、Cells の親オブジェクトは、一極化するわけです。

見通しとか見易さとかいう問題以上は、特に、問題もないと思いますね。

お礼

Wendy02 さん、こんにちは。
アドバイスありがとうございます。

>C列、M列は、合わせてしまってよいと思います。

これは、同じループ内で処理してよいということですか？
先のお礼欄にマクロの記録でとったコードを記載していましたが、C列のほうは該当のシートに順番にデータをコピペできたのですが、M列のほうがC列検索で貼り付けられたデータと重なって貼り付けられたりして、うまくいきませんでした(>_<)

貼り付けられたデータを見る限りでは、指定したシートへはコピペされているようですが、貼り付け先のシートで行がうまく選択できていないようでした。
Sheet1の4行目C列検索→M列検索、5行目C列検索→M列検索、6行目C列検索→M列検索…というふうに、行ごとに検索して指定のシートへコピペされると思っていたのですが。。。(@_@)

回答No.7

Wendy02

こんばんは。

#5の回答者です。

>コピーする対象は、同行のデータの一部で、連続しないセルの範囲だったりするので、それを指定するよりも、行全体を貼り付けて、後で不要部分を削除したりしたほうが良いかなと思ったのですが。。。

うーん、後で処理するよりは、おそらく、同じコードの中の処理で行ったほうがよいのですが、その規則性がどの程度のもか、というものもありますね。人間が理屈で判断できるものは、仮にそのつど違う長さであっても、すべて出来るはずです。

範囲を変えるなら、

>Sub CopyRows(ByVal myRow As Long, ByVal shName As String)

ActiveSheet.Rows(myRow).Copy .Cells(j, 1)

の部分で処理をしてくださればよいというか、最初から、そういう想定範囲にはありましたが、その範囲の判定を、どの程度までするか、ということですね。それは、ご自身が決定というか、一度、相談に出しても、今のここの流れの勢いなら、良い方向に結びついていくと思います。

お礼

Wendy02 さん、こんにちは。
アドバイスありがとうございます。

>人間が理屈で判断できるものは、仮にそのつど違う長さであっても、すべて出来るはずです。

コピーする対象と同様に、貼り付け位置も連続していないセルだったりするので、とりあえず、マクロの記録をとるために、実際に手作業でやってみて、セルの位置を変数に書き換えてみました。

For Rw1 = 4 To Cells(Rows.Count, 2).End(xlUp).Row
If Cells(Rw1, 3).Value <> "" Then
i = Sheets(Sheets("Sheet1").Cells(Rw1, 3).Value).Cells(Rows.Count, 3).End(xlUp).Row + 1
Range(Cells(Rw1, 12), Cells(Rw1, 14)).Copy Sheets(Sheets("Sheet1").Cells(Rw1, 3).Value).Cells(i, 2)
Range(Cells(Rw1, 7), Cells(Rw1, 8)).Copy Sheets(Sheets("Sheet1").Cells(Rw1, 3).Value).Cells(i, 5)
Range(Cells(Rw1, 9), Cells(Rw1, 11)).Copy Sheets(Sheets("Sheet1").Cells(Rw1, 3).Value).Cells(i, 9)
End If
Next Rw1

Sheet1は、表形式(B列～U列)で、B列～K列、L列～U列で対になっています。
最終的には、C列に入力されている値を元に、それぞれのシートへデータをコピーするという同様の作業を、M列に入力されている値を元にしてもやりたいのですが、検索する列が複数でも可能なのでしょうか？
今回の質問で、C列での方法がわかれば、M列でも同じようにすればいいだろうと思い、質問文にはC列に関することのみ記載していたのですが。。。

一応、M列に入力されている値を元にするパターンでも、マクロの記録をとってみました。

For Rw2 = 4 To Cells(Rows.Count, 2).End(xlUp).Row
If Cells(Rw2, 13).Value <> "" Then
j = Sheets(Sheets("Sheet1").Cells(Rw2, 13).Value).Cells(Rows.Count, 13).End(xlUp).Row + 1
Range(Cells(Rw2, 2), Cells(Rw2, 4)).Copy Sheets(Sheets("Sheet1").Cells(Rw2, 13).Value).Cells(j, 2)
Cells(Rw2, 17).Copy Sheets(Sheets("Sheet1").Cells(Rw2, 13).Value).Cells(j, 5)
Cells(Rw2, 18).Copy Sheets(Sheets("Sheet1").Cells(Rw2, 13).Value).Cells(j, 7)
Range(Cells(Rw2, 19), Cells(Rw2, 21)).Copy Sheets(Sheets("Sheet1").Cells(Rw2, 13).Value).Cells(j, 9)
End If
Next Rw2

回答No.6

onlyrom

＞この貼り付け先については、どうするのが良いのか悩んでいます

質問者がこんなことでは拙いのではありませんか。それに、

＞4行目以下に順番に貼り付けられるといいのですが。。。

などと小出しにするのもどうかと。。
rx-z5815さんは過去にも色々質問されてますのでその辺りのことは心得ていると思っていたのですがねぇ。(^^;;;

で、最初の質問の回答です。

'--------------------------------------------　
Sub Test()
　Dim R As Long
　For R = 4 To Range("A65536").End(xlUp).Row
　　　Rows(R).Copy Sheets(Cells(R, "A").Value).Cells(R, "A")
　Next R
End Sub
'-----------------------------------------------------

お礼

回答ありがとうございます。

アドバイスをいただきながら、より良い方法を…と思い、小出しにしたつもりもなかったのですが、単に分かりづらくさせてしまっただけのようで、申し訳ありません。

教えていただいたコードで試してみたところ、うまくいきました。
他の回答も参考にさせていただきながら、もう少し考えてみようと思います。

ありがとうございました。

回答No.5

Wendy02

こんにちは。

この前のこの前の続きですか？（^^;

一旦、コードを作ってはみて、#1のお礼でやり直ししてみました。
いまひとつ、分かりにくいのは、コピーする対象が明確ではないからです。
一応、全部をコピーしました。
たぶん、訂正になるだろうから、細かい話は、今回は置いておきます。

-----------------------------------------------------

'標準モジュール

Sub Test1()
Dim i As Long
　For i = 2 To Range("C65536").End(xlUp).Row
　　If Cells(i, 3).Value <> "" Then
　　　Call CopyRows(Cells(i, 3).Row, Cells(i, 3).Value)
　　End If
　Next i
End Sub

Sub CopyRows(ByVal myRow As Long, ByVal shName As String)
Dim ret As Variant
Dim j As Long
　ret = Application.ExecuteExcel4Macro(CStr(shName) & "!R1C1")
　If IsError(ret) = False Then
　With Worksheets(shName)
　　 j = WorksheetFunction.CountA(.Range("C4:C65536"))
　　 If j = 0 Then
　　　　j = 4　'初期行
　　 Else
　　　　j = .Range("C65536").End(xlUp).Row + 1
　　 End If
　　 ActiveSheet.Rows(myRow).Copy .Cells(j, 1)
　End With
　End If
End Sub

お礼

Wendy02 さん、こんにちは。
回答ありがとうございます。

教えていただいたコードで、実際に試してみたところ、うまくいきました。

>いまひとつ、分かりにくいのは、コピーする対象が明確ではないからです。

コピーする対象は、同行のデータの一部で、連続しないセルの範囲だったりするので、それを指定するよりも、行全体を貼り付けて、後で不要部分を削除したりしたほうが良いかなと思ったのですが。。。

もう少し考えてみようと思います。
ありがとうございました。

回答No.4

nekoron07

貼り付け元データは複数行あるのですか？
それとも１行ずつ入力しては貼り付け、というようにしたいのでしょうか。

とりあえず、元データ（Sheet1）は1行のみで、D列及びE列に転記したいデータが入っているとして作ってみました。
（ちなみに、C4のセルに数値が入っているとエラーが出ますので、文字列で入力（「'1234」等）してくださいね）

Sub macro()
Dim Sheet_Name, Data1, Data2
　　Range("C4").Select
　　Sheet_Name = ActiveCell
　　Data1 = ActiveCell.Offset(0, 1).Range("A1")
　　Data2 = ActiveCell.Offset(0, 2).Range("A1")
　　Sheets(Sheet_Name).Select
　　Range("A65536").Select
　　Selection.End(xlUp).Offset(1, 0).Select
　　ActiveCell = Data1
　　ActiveCell.Offset(0, 1) = Data2
End Sub

お礼

回答ありがとうございます。

>貼り付け元データは複数行あるのですか？
それとも１行ずつ入力しては貼り付け、というようにしたいのでしょうか。

貼り付け元データは複数行あります。表形式になっているので、その表全体のC列に入力されている値を元に、それぞれのシートへ順番にデータをコピーしたいのです。
教えていただいたコードも参考にさせていただきながら、もう少し考えてみたいと思います。

ありがとうございました。

回答No.3

hallo-2007

別に、E1にシート名　Sheet2といれておいて
Sheets(Range("E1").Value).Range("E2") = Range("E2")
上記の式で、Sheet2のE2に、現在のシートのE2の値が入りますが？
現在、出来ている式やエラーになった行を提示していただけると
間違い部分の訂正につながると思います。
最初からといわれるのであれば、マクロの記録を実行して、
コピィしたい行を選択、貼り付けたいシートへ移動、貼り付けたい列を選択、貼り付け、元のシートに戻る、
マクロの記録を終了
出来上がったマクロの中に、シートの移動の部分があると思いますが、
シート名に"Sheet2"とかなっている箇所に
シート名が入っているRANGE("A1").VALUE
に変えてみてやってみてください・

お礼

アドバイスありがとうございます。

>Sheets(Range("E1").Value).Range("E2") = Range("E2")
上記の式で、Sheet2のE2に、現在のシートのE2の値が入りますが？

上記の式は、別件で質問した際に教えていただきました。他の回答も参考にさせていただきながら、もう少し考えてみようと思います。
ありがとうございました。

回答No.2

gatt_mk

ご質問者がやりたいことはC列に入力されている値別にシートを分けてデータを抜き出したいということなのでしょうか?

そうであれば元のシートにある列数と行数に相当する配列を作成し、データを入力してあるシートを上から順番に条件列（C列）の値を検索して、条件に合致した行のデータを順番に配列に格納し、全件検索終了後に格納した配列のデータをそのまま対象のシートに貼り付けるのが簡単だと思います。

配列の概念やVBAでの配列の宣言の仕方がわからないと少し難しいかもしれません。

お礼

アドバイスありがとうございました。

回答No.1

n-jun

>Sheet1のC4セルに「１２３４」(文字列です)と入力されていたら、「１２３４」シートに、Sheet1のC4セルと同行のデータを貼り付け
シート名"１２３４"のどこに貼り付けるのでしょう？
Ｃ４なら４行目？

お礼

書き込みありがとうございます。

>シート名"１２３４"のどこに貼り付けるのでしょう？
Ｃ４なら４行目？

この貼り付け先については、どうするのが良いのか悩んでいます。
4行目以下に順番に貼り付けられるといいのですが。。。

よろしくお願いします。