Excel2007VBA セルへ転記

質問

はじめて参加させて頂きました。宜しくお願い致します。
VBA初心者なのですが必要にかられて始めました。
最初から難問を与えられて困っております。早速ですが
[sheet1]に入力フォームを作りました。
[sheet2]は、既存の日報があります。
A B C D E F G H
1 社番 　　　　　　　　　　　　 1 　 2 　 3 　 4 　5　 ←日付
---------------------------------------------------------
2　　1001　　氏名　　日勤
3　　　　　　　　　　　　残業
---------------------------------------------------------
4 1002　　氏名 　日勤
5　　　　　　　　　　　　残業
-----------------------------------------------------
このような日報です。
（A＝社員番号、B＝氏名、C＝日勤・残業、D～AH＝1～31）見づらくてすみません。

やりたい事は、[sheet1]の各セルに日付＝４、社番（社員番号）＝1002、日勤＝1、
残業＝1（残業が無ければ0が入ります）を入力したら
[sheet2]の（G4)に１、（G5）に１と転記したいのですがどうしたらよいでしょうか？

ありえないとお叱りを頂く事は、覚悟しております。
何分　上司から日報のスタイルを崩さずに・・との命令でして・・・。

何か良いアドバイスを頂けると幸いです。
どんな事でもかまいません。（ヒントだけでもかまいません・・）
どうか宜しくお願い致します。

回答No.1

keithin · ベストアンサー

日報シートの何番地のセルに何を記入しようとしているのか、説明がありません。

Sheet1の
Ａ１に日付
Ａ２に社番
Ａ３に日勤（１または０？）
Ａ４に残業（１または０）
からSheet2に転記します。
日付は１から３１までの単純な数字で記入しているものとします。

sub macro1()
　dim d as long
　dim r as long
　on error resume next

　d = worksheets("Sheet1").range("A1").value　
　r = application.match(worksheets("Sheet1").range("A2").value, worksheets("Sheet2").range("A:A"), 0)

’データチェック
　if d = 0 then
　　msgbox "BAD DATE"
　　exit sub
　end if
　if r = 0 then
　　msgbox "BAD NUMBER"
　　exit sub
　end if

’本番
　worksheets("Sheet2").cells(r, d + 3).value = worksheets("Sheet1").range("A3").value
　worksheets("Sheet2").cells(r + 1, d + 3).value = worksheets("Sheet1").range("A4").value
end sub

お礼

早速のご回答ありがとうございます。
実は、一人の社員番号に５つの項目があります。
いずれも（０or１）が入ります。
それを縦、横でセルを探し出す事ができませんでした。
しかし今試したところ思い通りに行っております。
後は、腐りかかった頭をフル活動して物にしたいと思います。
本当にありがとうございました。
ただただ感謝です。

補足

昨日　sheetとセルを変え項目を増やし完璧に動いていました。
が、今日ウキウキで開いたところ
"BAD　DATE"で止まってしまいます。
何が潜んでいるのか・・・
日付は、(D：AH)に1～31まで単純に入っております。
試行錯誤しているのですが何分"超"の付く初心者で頭が動きません。
今一度　ご教授頂けますでしょうか。