エクセルのマクロを使って・・・

質問

見積書を作成するマクロを作っているのですが、シートの追加がうまくいかず困っています。
見積書を作る際に、明細を入力する行が足らない時に、あらかじめ、作ってある『明細マスター』と言う名前のシートから、明細書をコピーして新しいシートを挿入して、そこに貼り付けると言う作業を、最大で“明細書(1)～(5)”5枚のシートを追加できる…と言う、マクロを作りたいのですが…
追加する枚数はその都度、違うそうなので、1回実行すると、『明細書(1)』が追加され、2回目の実行で『明細書(2)』が追加・・・・・
と言うようなマクロを作りたいのですが・・・

Sub 明細書()
Worksheets.Add After:=ActiveSheet
ActiveSheet.Name = "明細書(1)"
Sheets("明細マスター").Select
Cells.Select
Selection.Copy
Application.CutCopyMode = False
Selection.Copy
Sheets("明細書(1)").Select
Cells.Select
ActiveSheet.Paste
Range("B2").Select
End Sub

上記のマクロで、一枚だけの追加だと明細書が追加されるんですが、それを最大５枚まで追加すると言うマクロが分かりません。

質問が、分かりにくかったら申し訳ありませんが、よろしくお願いいたします。

回答No.1

zap35 · ベストアンサー

例えばこんなマクロでしょうか。
既存シートの番号が連続していないケースなどは想定していませんので、もし必要とあらばご自身で追記してみてください。

Sub Macro1()
Dim cnt As Integer
Dim wkNum As Double
Dim ws As Worksheet
　For Each ws In Worksheets
　　If Left(ws.Name, 4) = "明細書(" Then
　　　If IsNumeric(Mid(ws.Name, 5, 1)) Then
　　　　wkNum = Val(Mid(ws.Name, 5, 1))
　　　　If cnt < wkNum Then
　　　　　cnt = wkNum
　　　　End If
　　　End If
　　End If
　Next ws
　If cnt >= 5 Then
　　MsgBox ("明細書シートが既に５枚以上あるため追加できません")
　　Exit Sub
　Else
　　Sheets("明細マスター").Copy after:=Sheets(Worksheets.Count)
　　ActiveSheet.Name = "明細書(" & cnt + 1 & ")"
　End If
End Sub

補足

回答、ありがとうございます。
そのままコピーして使わせて頂きました☆
シートの追加は無事、うまく行ったんですが…
各シートで小計をとって、その小計を表紙（見積書）にコピーして来て、全てのページの集計を取れるように…と言われてしまい、また分からなくって困っています＞＜
もし、お時間がおありなら、そのマクロが分かったら教えて頂けると幸いです。
詳しく言うと・・・
追加されたシート『明細書（1）～（5）』の、セル『E31:F31』を、表紙『見積書』の『D52～D56』にコピーすると言う内容です。
D52～D56は最後に集計を取る時の数式に使用します。
色々、聞いて申し訳ありませんが、よろしくお願いします。

回答No.2

Wendy02

こんばんは。

私の場合は、歯抜けがあったら、そこを埋めてしまいます。なるべく、元のコードを活かしつつ作ってみました。このコードは、新しく作ったシートの名前にエラーがあったら、シートの枝番を足すという作り方です。

Sub 明細書R()
Dim NewSheet As Worksheet
Dim i As Integer
Set NewSheet = Worksheets.Add(After:=ActiveSheet)
On Error GoTo ErrHandler
　　i = 1
　　Do
　　NewSheet.Name = "明細書(" & CStr(i) & ")"
　　Loop Until Err.Number = 0
　　Worksheets("明細マスター").Cells.Copy NewSheet.Range("A1")
　　Err.Clear
　　Range("B2").Select
　　Application.CutCopyMode = False
　　Set NewSheet = Nothing
Exit Sub

ErrHandler:
　i = i + 1
　Err.Clear
　If i > 5 Then
　 MsgBox "OverLimt 5 Sheets", 64
　 Application.DisplayAlerts = False
　　 NewSheet.Delete
　 Application.DisplayAlerts = True
　 Exit Sub
　End If
　Resume
End Sub

お礼

回答ありがとうございます。すごく参考になりました。
まだまだ完成まで程遠いので、、もう少し勉強しつつがんばります。