Created
September 9, 2024 08:59
-
-
Save eyasuyuki/02ca37a2ce4e804dc2a63056529344d3 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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