CopyAndCleanWorkbook.vba

Sub CopyAndCleanWorkbook()
    Dim originalFileName As String
    Dim copyFileName As String
    Dim originalWb As Workbook
    Dim copyWb As Workbook
    Dim ws As Worksheet
    Dim wsCopy As Worksheet
    Dim cell As Range
    Dim vbComp As Object
    
    ' 元のファイル名とコピー先のファイル名を設定
    originalFileName = ThisWorkbook.FullName
    copyFileName = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1) & "_Clean.xlsx"
    
    ' 元のファイルをコピーして新しい名前を付ける
    FileCopy originalFileName, ThisWorkbook.Path & "\" & copyFileName
    
    ' コピーしたファイルを開く
    Set copyWb = Workbooks.Open(ThisWorkbook.Path & "\" & copyFileName)
    
    ' ワークブック内の各シートを処理
    For Each ws In copyWb.Sheets
        ' 計算式を値に変換
        ws.Cells.Value = ws.Cells.Value
        
        ' セルのフォーマットと書式設定を保持しながら、計算式を値に変換
        For Each cell In ws.UsedRange
            cell.Value = cell.Value
        Next cell
    Next ws
    
    ' マクロの削除
    For Each vbComp In copyWb.VBProject.VBComponents
        If vbComp.Type = 1 Then ' モジュール
            copyWb.VBProject.VBComponents.Remove vbComp
        End If
    Next vbComp
    
    ' コピー先のファイルを保存して閉じる
    copyWb.Save
    copyWb.Close
    
    MsgBox "ファイルのコピーとクリーニングが完了しました。"
End Sub