『日数分をシートコピーしたい』（torao）

お世話になっております。
質問させてください。

ネット等で調べて日報を日数分コピーするマクロを貼りました。
Sub copy()
For i = 1 To 5
c = c + 1
Worksheets("日報").Copy after:=Worksheets("日報")
Worksheets("日報 (2)").Name = c & "日目"
Next
End Sub

これで5日分のシートが出来ましたが、「日報」シートとは別に、
「基本項目」のシートを作成し、工期を入力したいと思います。

「基本項目」
  　A　　　 B　　　　　　C　　 　　D　　　　 E
1 工事名　○○新築工事
2 工期　　2016/3/1　　　から　2016/5/15　　 まで
3 請負者  株式会社　○○

上記のような工期があった場合、2ヵ月半のシートをコピーしたいのですが、
どのようにもとのマクロを変更したら良いか、教えていただけませんでしょうか。



＜ 使用 Excel：Excel2013、使用 OS：Windows7 ＞
----
 あまり効率はよくないかもしれませんが･･･

 Sub test()

     Dim 日付 As Date
     Dim 位置 As Long
    
     Application.ScreenUpdating = False
    
     日付 = Range("B2").Value
     位置 = Worksheets("基本項目").Index
    
     Do
         Worksheets("基本項目").Copy After:=Worksheets(位置)
         ActiveSheet.Name = Format(日付, "yyyy-m-d")
         日付 = 日付 + 1
         位置 = 位置 + 1
     Loop Until ActiveSheet.Name = Format(Range("D2").Value, "yyyy-m-d")
    
     Application.ScreenUpdating = True

 End Sub

 スラッシュはシート名に使えないので形式は2016-3-1のようになっています。
（se_9） 2016/03/10(木) 15:19
----
（se_9）様

さっそくの返信ありがとうございます。

頂いたマクロを実行いたしましたが、書き方が拙くて申し訳ありません。
シートをコピーしたいのは「日報」シートで、どんな作業をしたのか記入する様式になっています。

「基本項目」で工期を記入し、その日数分の「日報」シートをコピーしようと思っています。

どうかよろしくお願いいたします。
（torao） 2016/03/10(木) 15:31
----
 いつものトンチンカンな回答をしてしまいました。すみません。

 Sub test()

     Dim 日付 As Date
     Dim 位置 As Long
    
     Application.ScreenUpdating = False
     
     日付 = Worksheets("基本項目").Range("B2").Value
     位置 = Worksheets("日報").Index
    
     Do
         Worksheets("日報").Copy After:=Worksheets(位置)
         ActiveSheet.Name = Format(日付, "yyyy-m-d")
         日付 = 日付 + 1
         位置 = 位置 + 1
     Loop Until ActiveSheet.Name = Format(Worksheets("基本項目").Range("D2").Value, "yyyy-m-d")
    
     Application.ScreenUpdating = True

 End Sub
（se_9） 2016/03/10(木) 15:38
----
（se_9）様

頂いたマクロでシートコピー出来ました。
本当にありがとうございます。
仕事が捗ります。

また何かありましたらお願いいたします。
（torao） 2016/03/10(木) 15:55
----
（se_9）様
もう一つお聞きしたいのですが、
ActiveSheet.Name = Format(日付, "yyyy-m-d")
の日付を平成〜に出来るでしょうか

増やしたシートのB4に工期分の日付を入れたいのですが、
平成○○年○月○日(○曜日)←このような形です

シート名からセルに入れてみようと下記の様に変更してみました

ActiveSheet.Name = Format(日付, "gggee"年"mm"月"dd"日"(aaaa)")

コンパイルエラーになってしまい、出来ませんでした。

それとも違う方法がありますでしょうか。
お願いいたします。

（torao） 2016/03/10(木) 16:25
----
 "ggge年mm月dd日(aaaa)" にしてください。
（se_9） 2016/03/10(木) 16:38
----
（se_9）様
返信ありがとうございます。

ActiveSheet.Name = Format(日付, "ggge年mm月dd日(aaaa)")

このようにやってみましたら、日付以上のシートが大量に出来てしまいました。

なにか他に原因があるのでしょうか…。
何度もすみません。
（torao） 2016/03/10(木) 16:47
----
 Loop Until ActiveSheet.Name = Format(Worksheets("基本項目").Range("D2").Value, "yyyy-m-d")
 の"yyyy-m-d"も変えましたか？アクティブシートの名前が工期の○○まで（今回のケースだと平成28年05月15日(日曜日)）と
 合致しなければずっとシートを作成し続けることになります。なので書式を変える際は必ずLoop〜のところも一緒の書式に
 してください。
（se_9） 2016/03/10(木) 16:54
----
 Do/Loop ではなく For/Next で書いてみました。

 Sub 別案()
    Dim z As Long
    Dim f As Long
    Dim t As Long
    Dim x As Long
    
    Application.ScreenUpdating = False
    
    With Sheets("基本項目")
        f = .Range("B2").Value2
        t = .Range("D2").Value2
    End With
    
    z = Sheets("日報").Index
    
    For x = t To f Step -1
        Sheets("日報").Copy After:=Sheets(z)
        On Error Resume Next    '念のため
        ActiveSheet.Name = Format(x, "ggge年mm月dd日(aaaa)")
        On Error GoTo 0
    Next
    
 End Sub

（β） 2016/03/10(木) 18:10
----
（se_9）様、（β）様
本当にありがとうございます。

（se_9）様
その部分、直していませんでした…。
今日はもう退社してしまったので、明日やってみます。

（β）様
わざわざありがとうございます。
 「Do/Loop ではなく For/Next」
今は違いが分かりませんが、勉強したいと思います。
（torao） 2016/03/10(木) 20:21
----
 Do〜LoopじゃなくてFor〜Nextの方がいいのかなと思っていたらβさんから回答が。
 コート提示しておいて何ですが、βさんの方を使ってください。
（se_9） 2016/03/11(金) 07:48
----
（se_9）様
昨日はありがとうございます。

（β）様のマクロを使用したところ増やしたシートのB4に日付を入れたいのですが、
これを原紙であるところの「日報」に
「=RIGHT(CELL("filename",B4),LEN(CELL("filename",B4))-FIND("]",CELL("filename",B4)))」
このような関数をいれてみたところ、やはり日付の欄にすべて「日報」になってしまいました。

工期分のシートをコピーして、ついでに連続した日付も入れたかったんですが、なにか良い方法ありませんでしょうか。

（torao） 2016/03/11(金) 11:54
----
 そんな難しいことをする必要はないですよ。
 日報シートの B4 は　空白でＯＫ。表示書式を、お好きなものにしておいてください。

 で、ActiveSheet.Name = Format(x, "ggge年mm月dd日(aaaa)")　の下あたりに

 Range("B4").Value = x を追加してください。

（β） 2016/03/11(金) 12:10
----
（β）様
ちゃんと出来ました。
ありがとうございます。
助かりました。

（se_9）様もありがとうございます。

（torao） 2016/03/11(金) 15:16