ExcelのVBAにて

質問

ExcelのVBAにて

お世話になります。
今、請求書を作っています。
sheet1に請求書があり、sheet2に一覧があります。
sheet1の宛先欄に客先名を書いたら、該当する行を抜き出して請求書の欄に書き出すプログラムをお教えください。
<sheet1>

佐藤　様

ご請求額：３９００円

商品名　　　数量　　単価　　　金額
りんご　　　３　　　５００　　１５００
バナナ　　　４　　　６００　　２４００

<sheet2>
請求先　　商品名　　数量　　単価　　金額
佐藤　　　りんご　　　３　　５００　１５００
田中　　　りんご　　　２　　５００　１０００
田中　　　ばなな　　　１　　６００　　６００
佐藤　　　ばなな　　　４　　６００　２４００

と、いう感じのExcelファイルです。

回答No.2

keithin · ベストアンサー

sub macro1()
　worksheets("Sheet1").range("5:65536").delete shift:=xlshiftup
　worksheets("Sheet2").range("A:E").autofilter _
　　field:=1, criteria1:=worksheets("Sheet1").range("A1")
　worksheets("Sheet2").autofilter.range.offset(0, 1).copy _
　　destination:=worksheets("Sheet1").range("A5")
　worksheets("Sheet1").range("A3").formula = "=SUM(D:D)"
　worksheets("Sheet1").range("A3").numberformatlocal = "ご請求額!：#,##0円"
　worksheets("Sheet2").autofiltermode = false
end sub
など。

お礼

早速にありがとうございます。

とてもシンプルでわかりやすいです。

参考にさせていただきます。

回答No.1

kmetu

Sub test()

i = 5
With Worksheets("Sheet2").Range("a1:a500")
Set c = .Find(Worksheets("Sheet1").Range("A1").Value, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Worksheets("Sheet1").Range("A" & i) = c.Offset(0, 1).Value
Worksheets("Sheet1").Range("B" & i) = c.Offset(0, 2).Value
Worksheets("Sheet1").Range("C" & i) = c.Offset(0, 3).Value
Worksheets("Sheet1").Range("D" & i) = c.Offset(0, 4).Value
i = i + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With

End Sub

セル番地は実際にあわせて書き直してください。

お礼

早速にありがとうございます。

うまくいきそうです。
ありがとうございました。