エクセルでこんなことできますか？ マクロ？関数？マクロ・関数の合せ技？ 自分...

シート名：データベース
シート名：購入先1
シート名：購入先2
シート名：購入先3
というシートを用意して
ＡＬＴ＋Ｆ１１ボタンを押して

データベースのところをダブルクリックして

以下のマクロを貼り付けたらどうでしょうか。
ただし、まとめて貼り付けたりするとはじめの行のものしか別シートに反映されませんけど。

Private Sub Worksheet_Change(ByVal Target As Range)
'■■■番号が入力された時の処理■■■
If Target.Column = 1 Then 'And Target.Row <= 1000 Then '変更されたセルが１列なら
On Error GoTo exit1
Select Case Target.Value
Case 1
sh = "購入先1"
r = 2
Do Until Sheets(sh).Cells(r, 2) = ""
r = r + 1
Loop
Sheets(sh).Cells(r, 2) = Cells(Target.Row, Target.Column + 1)
Case 2
sh = "購入先2"
r = 2
Do Until Sheets(sh).Cells(r, 2) = ""
r = r + 1
Loop
Sheets(sh).Cells(r, 2) = Cells(Target.Row, Target.Column + 1)
Case 3
sh = "購入先3"
r = 2
Do Until Sheets(sh).Cells(r, 2) = ""
r = r + 1
Loop
Sheets(sh).Cells(r, 2) = Cells(Target.Row, Target.Column + 1)
End Select
End If
'■■■商品名が入力された時■■■
If Target.Column = 2 Then 'And Target.Row <= 1000 Then '変更されたセルが2列なら
Select Case Cells(Target.Row, Target.Column - 1)
Case 1
sh = "購入先1"
r = 2
Do Until Sheets(sh).Cells(r, 2) = ""
r = r + 1
Loop
Sheets(sh).Cells(r, 2) = Target.Value
Case 2
sh = "購入先2"
r = 2
Do Until Sheets(sh).Cells(r, 2) = ""
r = r + 1
Loop
Sheets(sh).Cells(r, 2) = Target.Value
Case 3
sh = "購入先3"
r = 2
Do Until Sheets(sh).Cells(r, 2) = ""
r = r + 1
Loop
Sheets(sh).Cells(r, 2) = Target.Value
End Select
End If
exit1:

End Sub

http://my.opera.com/karakara/blog/2008/10/20/vlookup