sample/yojitsu - konkensyu @ ウィキ

Sub 予実FBファイル作成マクロ()

'エラー処理用

   On Error GoTo errHandler

'名称定義

   Dim 作業フォルダ名 As String
   Dim マクロ名 As String
   Dim 予算ファイル名 As String
   Dim 予算シート名 As String
   Dim 保存名 As String
   Dim 対象シート As Variant

'条件取得

   作業フォルダ名 = ThisWorkbook.Path          '作業するフォルダのパスを取得
   マクロ名 = ActiveWorkbook.Name              '起動マクロのファイル名取得
   予算ファイル名 = Range("C7").Value            '予算反映するシート名取得
  

'対象カテゴリの指定

   Set 対象シート = Application. _
       InputBox(prompt:="予実FBを作成したいシート名を指定", Type:=8)   '対象範囲指定
   対象シート.Select
                                  

'対象のループ

   For Each 対象シート In Selection
      
       Workbooks(マクロ名).Worksheets(Worksheets.Count).Activate
       Range("C9").Value = 対象シート
       予算シート名 = Range("C9").Value            '予算反映するシート名取得
       保存名 = 作業フォルダ名 & "\" & Range("C11").Value          '保存名取得
      
   '予算シートのコピー
       Workbooks(予算ファイル名).Activate
       Worksheets(予算シート名).Activate
       ActiveSheet.Range("F6:Q110").Copy

' ActiveSheet.Range("S5:AD109").Copy

   'コピーした予算の貼付（値貼付）
       Workbooks(マクロ名).Worksheets("予算").Range("F6").PasteSpecial xlPasteValues
      
   '予算シート記入名称の代入
       Workbooks(マクロ名).Worksheets(1).Range("E3").Value = 予算シート名
  
  
   'データの保存
       Workbooks(マクロ名).Worksheets(Array(1, 2, 3, 4, 5)).Copy  '予実報告～対象表をコピー
       ActiveWorkbook.SaveAs Filename:=保存名 & ".xlsx", _
                   FileFormat:=xlOpenXMLWorkbook    'EXCEL2007形式で保存
   Next

   Exit Sub
  

errHandler:

   MsgBox Err.Description
      

End Sub