エクセルのマクロで別のシートにボタンで転記させる

こんにちは。

一枚のsheet1のA5からE5の1行分を、別のsheet2に転記したいと思っています。
条件としては、ボタンで、sheet1で入力したC5の値をsheet2のD列から探し、探した値の右横にsheet1のA5からE5の1行分を転記したいと思っています。

イメージとしては、ある顧客にたいし、問い合わせのあった内容を、その都度データベースとして別シートに蓄積していく感じです。

ただ、sheet2のD列には、顧客の名前、Eから K列には、顧客の基本情報を入れてあるので、L列から5列ずつを1回分の問合せ内容として、sheet1に入力したものを転記、蓄積したいと考えています。

どのようなマクロをかいたらよいか、ご教授願えますでしょうか。
よろしくお願いいたします。

質問者からの補足コメント

• また、値だけを貼り付けらる場合は何らかの指定をしないといけないかと思いますが、ご教授願えますでしょうか。
  よろしくお願いいたします。

    補足日時：2016/06/03 14:08

No.11 回答者： fujillin 回答日時： 2016/06/03 16:44

ANo1です。

なんだか苦戦なさっているようですので、ご参考までに、こちらでもサンプルを作成してみました。
処理方法はNo1に記した手順に沿っています。
ご質問の内容を再確認したところ、元データのC5セルの内容は顧客名と一致しているはずですが、蓄積シートの欄へコピーする内容にも含まれていますよね？
ということは、結果として、顧客名別に蓄積する行の5列おきに（記載する必要のなさそうな）顧客名が繰り返し出てくることになり、蓄積シートの効率や一覧性が若干悪くなるような気がします。

・・・などということはさておいて、以下ではどうでしょうか？
※ エラー処理等は考慮していません。
　 ただし、顧客リストに参照値が無い場合がありそうなので、
　 これだけは対応しています。

Sub Sample()

Dim dataSht As Worksheet, dbSht As Worksheet
Dim rw As Long, col As Long

Set dataSht = Worksheets("Sheet1") '元データシート
Set dbSht = Worksheets("Sheet2") '蓄積用シート

'リストから顧客行を検索
On Error Resume Next
rw = WorksheetFunction.Match(dataSht.Cells(5, 3).Text, dbSht.Columns(4), 0)
If Err.Number = 1004 Then
　MsgBox "該当する顧客が登録されていません"
　Exit Sub
End If
On Error GoTo 0

'記入開始列を算出
col = dbSht.Cells(rw, Columns.Count).End(xlToLeft).Column
col = Int((col + 3) / 5) * 5 + 2
If col < 12 Then col = 12

'データ（5列分）をコピー
dataSht.Range("A5:E5").Copy
dbSht.Cells(rw, col).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

End Sub

この回答へのお礼

ありがとうございます！
おっしゃる通りですが、C5セルではなく、B5セルの間違いでした。
申し訳ありません。

お礼日時：2016/06/04 03:04

No.12 回答者： fujillin 回答日時： 2016/06/04 10:21

ANo11です。

＞C5セルではなく、B5セルの間違いでした。
No11のサンプルではC5セルの内容で探すようになっているので、実行すると「登録されていません」の連発になってしまいますね。(^_^;)
とは言うものの、B5セルもコピー範囲内なので、列の位置が違うだけで、同じことになっていませんか？

いずれにしろ、検索値を指定しているのは
WorksheetFunction.Match(dataSht.Cells(5, 3).Text, dbSht.Columns(4), 0)
のところなので、そこで正しいセルを参照するようにしてあげれば、動作すると思います。

この回答へのお礼

ありがとうございました‼
うまくいきました！

お礼日時：2016/06/04 21:24