リストからフォーマットをコピーしてワークシートを追加するマクロについて

質問

マクロを勉強し始めたばかりで、いろいろ見ながらやっていますが、つまずいてしまいました。
やりたい事、コード、エラーになっているところは以下の通りです。
解決方法をご教示下さい。

【やりたい事】
あるデータリスト（sheet1）から1行ずつ、見積書を作成する
(1)見積書format（sheet2）をコピーし、表示されているsheetの後に追加
(2)シート名称を"取引先コード_部番"に変更
(3)sheet1のデータをコピーされたformatに転記
(4)作成対象列に「*」が入っているデータのみ対象とし、ループ処理
　※(4)はコードがわからず、うまく出来ていません。

【コード】
---------------------------------------------------
Sub Macro1()
作成対象 = Sheets(1).Range("A2")
取引先コード = Sheets(1).Range("B2")
部番 = Sheets(1).Range("C2")
　金額 = Sheets(1).Range("C2")　
no = Sheets.Count
i = 0
Do Until 作成対象 = ""
i = i + 1
Sheets(2).Copy after:=Sheets(no)
no = no + 1
Sheets(no).Name = "見積書（" & 取引先コード & "_" & 部番 & ")"
Range("B11").Value = 取引先コード
Range("AF13").Value = 部番
Range("BB13").Value = 金額
媒体No. = Sheets(1).Range("M2").Offset(i, 0)
Loop
End Sub
---------------------------------------------------
【エラー】
１行目のデータは意図どおり処理されますが、2行目以降、以下のコードでエラーになります。
どうも、シート名が同じになってしまう為のようです。
Sheets(no).Name = "見積書（" & 取引先コード & "_" & 部番 & ")"

回答No.2

noname#110201

ごめんなさい、遅くなりました。
お礼を書いていただいても、教えて！Goo からメールが来ないことがあるので、追加を書かれたのを知りませんでした。

(1)作成対象列に「*」を入れた行のみ見積書を作成

これには、まず、そのデータリストがどこまで続いているのか、何らかの方法で知る必要があります。
いくつか方法はあるのですが、一番説明しやすいので、最後の行のひとつ下の行のA列にENDと書いておくことでデータリストの終わりを知ることにします。

.......
Sheets(1).Range("A2").Select <-----
Do Until ActiveCell.Value = "END" <-----
...If ActiveCell.Value="*" Then <-----
......i = i + 1
.......
...EndIf <-----
...ActiveCell.Offset(1,0).Select <-----
Loop

要するに、ループに入った最初のところで、* がついているかいないかを調べて、付いていなければ、それ以後の処理をスキップしてしまうのです。

行頭のピリオドは無視してください。
どうしても行頭の空白が自動的に削除されてしまうので、字下げをするための苦肉の策です。

(2)作成された見積書シートをすべて削除するコード

For Each W In Worksheets
　If W.Name Like "*_*" Then W.Delete <----
Next W

では、どうでしょう。

補足

お礼が遅れまして申し訳ありません。
アドバイス頂いたように、当初のコードに追加してやってみたのですが、2つ目以降の"*"が選択されず、デバックに入りました。
大変申し訳ありませんが、最初に質問させていただいたコードに追加して頂いても宜しいでしょうか？

また（2）ですが、1sheetずつ削除する事は出来ることはわかったのですが、選択したシートすべてを一括で削除する事が出来ません。
シート選択後、activesheetのみ削除というのもやってみたのですが、formatシートまで削除されてしまいました。

本当に世話が焼けると思いますが、もう少しアドバイスをお願い致します。

回答No.1

noname#110201

>シート名が同じになってしまう為のようです。
Do Until のループの中で、取引先コードと部番を変えていませんので、もちろん、同じシート名になります。
Sheet1がどういう表になっているのかわかりませんが、例えば

取引先コード = Sheets(1).Range("B2").Offset(i, 0).Value
部番 = Sheets(1).Range("C2").Offset(i, 0).Value

のように(適当にアレンジしてください)、新しいデータを代入する必要があるでしょう。

補足

boc-ianさん、迅速なご回答ありがとうございます。
よく考えると仰る通りで、アドバイスのように変更したらきちんと実行されました。
追加で申し訳ないのですが、以下のコードもご教示頂けないでしょうか？
(1)作成対象列に「*」を入れた行のみ見積書を作成
　まったく見当がつきません
(2)作成された見積書シートをすべて削除するコード
　削除する際には、注意メッセージダイアログを表示し、選択されたシ　ートを一括削除

　以下のコードで選択は出来ました。
Sub シート選択()
Dim W As Worksheet
For Each W In Worksheets
　If W.Name Like "*_*" Then W.Select False
Next W
End Sub