【編集中 記事】Excelシート該当範囲をコピーし、別シートへ書式＆値のみコピー

作成の目的

毎日移り変わる日毎のテスト進捗を関数で取得し管理していたが
日毎のテスト進捗をログとして残す必要が出たため、別シートへ値として残すマクロを書きました。

Sub 各日報告シート出力くん()

  'ワークシートオブジェクト取得
  Dim ws As Worksheet

  'あとで条件判定に使うflag
  Dim flag As Boolean

  'マクロ実行時の日付(mmdd)で取得
  Dim TodayDate As String
  TodayDate = Format(Date, "mmdd")

  'コピー元シート名
  Dim CopyMotoSheet As String
  CopyMotoSheet = "FORMAT"

  'コピー元セル範囲
  Dim CopyMotoRange As String
  CopyMotoRange = "A1:K100"

  'コピー先シート名
  Dim OutputSheet As String
  OutputSheet = TodayDate & "_" & "進捗報告"

  'コピー先セル番地
  Dim OutputCell As String
  OutputCell = "A1"

  '本日分の作業報告シート有無調査
  'あれば、エラー表示
  'なければ、本日分作業報告出力
  For Each ws In Worksheets
    If ws.Name = OutputSheet Then flag = True
    Next ws
    
    If flag = True Then
      MsgBox ("本日分の【" & OutputSheet & "】シートがあるため出力できません。" & _
      Chr(10) & "再出力する場合､" & "【" & OutputSheet & "】シートを削除してください。")

    Else
      'シートを追加し、名前を「mmdd_進捗報告」にする
      Worksheets.Add After:=Worksheets(CopyMotoSheet)
      ActiveSheet.Name = OutputSheet

      '変数CopyMotoSheetシートの指定範囲を「mmdd_進捗報告」シートへコピペ
      Sheets(CopyMotoSheet).Range(CopyMotoRange).Copy
      Sheets(OutputSheet).Range(OutputCell).Select

      '書式 貼り付け
      Selection.PasteSpecial Paste:=xlFormats

      '値 貼り付け
      Selection.PasteSpecial Paste:=xlPasteValues


      'コピーモードが継続しているためESCさせる
      Application.CutCopyMode = False

      '処理実行後は、処理したシートのA1セルを選択しておく
      Range(OutputCell).Select
      Worksheets(CopyMotoSheet).Select
      Range(OutputCell).Select


      '列幅自動調節 どの列幅を調節しよう？
      Range("B:B").Columns.AutoFit
    End If
End Sub