Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(指定なし : 指定なし)
「既存のファイルがあった場合、シートを追加したい」のTANPOPOさんへ
投稿日時: 20/02/01 10:01:39
投稿者: もこな2

追いかけてまで言う必要もないかもですが、kesuシート要らないと思います。
もっと言うと、いちいち新規ブックを作成する必要がないです。
 
なぜなら、シートのコピー時に送り先を省略すると、新規ブックにコピーされる仕組みだからです。
 
よって、
既存ファイルがない場合 → 2,3,4番目のシートをコピーしたものを保存
既存ファイルがある場合 → 2,3,4番目のシートを既存ブックの末尾にコピーして保存
ということであれば、↓でよいとおもいます。

Sub テキトー()
    Const フォルダパス  As String = "T:\テスト"
    
    Dim ファイル名 As String
    Dim dstWB As Workbook
    
    ファイル名 = "\" & "週初レポート_" & Format(Date, "yymmdd") & ".xlsx"
    
    '▼ブックの有無を判定して分岐
    If Dir(フォルダパス & ファイル名) = "" Then
        
        '// シートを【新規ブックへ】コピー
        ThisWorkbook.Worksheets(Array(2, 3, 4)).copy
        Set dstWB = Workbooks(Workbooks.Count)
    Else
        
        '// シートを【既存ブック】の末尾へコピー
        Set dstWB = Workbooks.Open(フォルダパス & ファイル名)
        ThisWorkbook.Worksheets(Array(2, 3, 4)).copy after:=dstWB.Worksheets(dstWB.Worksheets.Count)

    End If
    
    '▼いずれの場合も名前を付けて保存(上書き保存)して閉じる
    Application.DisplayAlerts = False
    dstWB.SaveAs _
        filename:=フォルダパス & ファイル名, _
        FileFormat:=xlOpenXMLWorkbook
    Application.DisplayAlerts = True
    
    dstWB.Close

End Sub

 

回答
投稿日時: 20/02/06 11:57:23
投稿者: TANPOPO

もこな2さん
 
私への投稿があってびっくりしました。
確認させていただいたところ、私がぐちゃぐちゃにしながら作成したものより
数百倍効率よくファイルを作成することができました。
 
ありがとうございます。
名前をsub mokona2()にさせていただきました。
 
ご指摘いただき、わざわざご投稿いただき、感謝です。
ありがとうございました。

投稿日時: 20/02/13 22:02:28
投稿者: もこな2

急な長期出張でPCが触れませんでした。
閉じます。