Skip to content

Instantly share code, notes, and snippets.

@eyasuyuki
Created September 9, 2024 08:59
Show Gist options
  • Save eyasuyuki/02ca37a2ce4e804dc2a63056529344d3 to your computer and use it in GitHub Desktop.
Save eyasuyuki/02ca37a2ce4e804dc2a63056529344d3 to your computer and use it in GitHub Desktop.
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment