今回は、前回(VBAでBingo5_5)PDFに出力したものをExcel(Book)に出力するものを作ります。そして次回(予告：VBAでBingo5_7)では、今回の処理で出力したBookのデータを取込む処理を考えています。
これは、各支所や支店等に入力票を送信して、返信された回答書を集計するときなどに応用できるかと思いますので、参考にしてください。

今回の準備は二つです。まず前回作ったフォルダ「Bingo5」の中にフォルダ「Book」を作ってください。次にB5.xlsmを開いて、実行ボタン「Book出力」を作ってください。

それでは、コーディングを始めます。今回のメインは「シートを、新しいBookに書き出す」処理なので、いつものようにマクロの記録で手順を記録します。
手順は、シート「編集」のシートタブを右クリックして表示されるウィザードの「移動またはコピー」をクリック。続けてダイヤログボックスの移動先ブック名の「（新しいブック）」を選択、コピーを作成するにチェックを入れてOKボタンをクリックして、作成された新しいブックの「×」＞「保存」をクリック。ダイヤログボックスで、保存先を「デスクトップ」ファイル名を「一時.xlsx」として「保存」をクリックで完了です。

Sub Macro1()
'
' Macro1 Macro
'

'
    Sheets("編集").Select
    Sheets("編集").Copy
    ChDir "C:¥Desktop"
    ActiveWorkbook.SaveAs Filename:="C:¥Desktop¥一時.xlsx", FileFormat _
        :=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close

マクロが確認できたら、今作った「一時.xlsx」は不要なので削除してください。
今回の処理では、Sheets("編集").Copyと
ActiveWorkbook.SaveAs Filename:="C:¥Desktop¥一時.xlsx", FileFormat _ 　　　　:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Closeを使います。
前回のPDF化と同様に「Book名、出力先、対象シート」の情報が必要となります。

Book名(Bn)を「B5_xxx.xlsx」として、xxxを回別に置換えましょう。
出力先は、「B5.xlsm（自分自身）」と同じフォルダにあるフォルダ「Book」なので前回と同じようにDR=ThisWorkbook.Path & "¥Book"とします。
対象シートも前回同様複数シートなので、配列の要素にセットします。今回は配列名をBBBとしましょう。

そして、処理終了後は前回同様シート削除の指示を受けて処理しましょう。
完成コードサンプルは

Sub Exp_B()

    Kb = Sheets("抽出").Cells(3, "L")
    Bn = Replace("B5_xxx.xlsx", "xxx", Kb)  'Book名

    Sc = Sheets.Count
    ReDim BBB(Sc - 2)

    For i = 2 To Sc
      BBB(i - 2) = Sheets(i).Name
    Next i

    Sheets(BBB).Copy
    DR = ThisWorkbook.Path & "¥Book"

    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=DR & "¥" & Bn, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False 'Sheetを新規Bookとして書き出す
    Application.DisplayAlerts = True
    ActiveWindow.Close

    RC = MsgBox("　　Book作成が完了しました。" & Chr(13) & Chr(13) _
              & "　　処理済のシートを削除しますか？" & Chr(13) _
              & "　　　[は   い]：削除する" & Chr(13) _
              & "　　　[いいえ]：削除しない" & Chr(13) _
                , 4 + 32, "Bingo5　　　　　　　　　　　　　　nJun")  '意思確認メッセージ
    If RC = 6 Then    '応答ボタン「はい」のとき

       Application.DisplayAlerts = False  'シート削除警告メッセージを非表示
       For n = 3 To Sc
         Sheets(3).Delete  'シート削除
       Next n
       Application.DisplayAlerts = True   '警告メッセージを表示モードに戻す

    End If
    Sheets("抽出").Select '抽出をActiveSheetにする

End Sub

のようになります。
実行ボタン「Book出力」と関連付けしてください。
前回とほぼ同じ構造なので、比較してみてください。
また、前回同様「Macro1」は不要です。

実行ボタン「Book出力」をクリックすると、フォルダ「Book」内にBookが作成されることをご確認ください。

今回も最後までご覧いただき、ありがとうございました。