Excelブックが破損?新しいブックへコピーするVBAコード

こんにちは!大阪市を拠点に活動している『縁紡ぐ』の稲垣です。

SWELLを使ったホームページ制作や、Excel、ACCESS、RPAなどのシステム開発を行っています。
また、Excel、Word、Outlookの研修や、情報セキュリティ研修も行っています。身近なITの相談相手になりたいと思っています。

お気軽にお問い合わせください。

目次

Excelブックが破損?新しいブックへコピーするVBAコード

Excelで大事な作業をしていると、ファイルが突然破損してしまったり、不安定になってくることがあります。特にマクロや複雑なシートが含まれるブックでは、このリスクは高くなります。この記事では、破損し始めたExcelブックを安全に新しいブックにコピーするためのVBAコードを紹介します。この記事を最後まで読めば、大事なファイルを簡単に救出できるようになります

なぜブックが破損するのか?

Excelが破損する原因はさまざまです。実際に、不安定になったExcelの相談は、ちょこちょこあります。
原因の一例ですが、ファイルサイズが大きすぎる、複雑な数式やマクロが多すぎる、またはハードウェアの故障などが考えられます。ブックが完全に破損すると、開くことができなかったり、データが消失したりする可能性があるので、バックアップや今回ご紹介する新しいブックに作り直しすことをおススメします。

こまめなバックアップも重要ですが、新しいExcelブックにすべてデータを移すと、安定することが多いです。ただし、新しいExcelブックにシートのコピーをして移すだけでは、解消しないことがあります。シートにある問題をそのまま新しいブックに移すだけになる時があるからです。

コピーを実現するVBAコード

ここで紹介するVBAコードは、Excelブック内のすべてのシート、モジュール、ユーザーフォーム、クラスを新しいブックへコピーします。特に、シートのコードがアクティブになったときに動作するイベントも一時的に無効化し、スムーズにコピーを行えるようにしています。

実行前に、シートの保護は解除しておいてください。

すべての設定を移行するわけではありません

Sub CopyWorkbookSafely()
    Dim sourceWorkbook As Workbook
    Dim newWorkbook As Workbook
    Dim ws As Worksheet
    Dim newSheet As Worksheet
    Dim cell As Range
    Dim vbComp As VBComponent
    Dim vbCompDest As VBComponent
    Dim modName As String
    Dim sheetIndex As Integer

    ' イベントを無効化
    Application.EnableEvents = False
    Application.ScreenUpdating = False

    ' 破損し始めた元のブックを参照
    Set sourceWorkbook = ThisWorkbook

    ' 新しいブックを作成 (マクロ対応)
    Set newWorkbook = Workbooks.Add(xlWBATWorksheet)

    ' 各シートを手動でコピー(セルデータ、フォーマット、オブジェクトを含む)
    For Each ws In sourceWorkbook.Worksheets
        ' 新しいシートを追加
        ws.Copy After:=newWorkbook.Sheets(newWorkbook.Sheets.Count)
        
        ' コピーしたシートを取得
        Set newSheet = newWorkbook.Sheets(newWorkbook.Sheets.Count)

        ' 数式を一旦文字列に変換して保存
        For Each cell In newSheet.UsedRange
            If cell.HasFormula Then
                cell.Value = cell.Formula
            End If
        Next cell

        ' 数式を再度適用(元のシートへの参照を排除)
        For Each cell In newSheet.UsedRange
            If Left(cell.Value, 1) = "=" Then
                cell.Formula = cell.Value
            End If
        Next cell
    Next ws

    ' デフォルトで作成された最初のシートを削除
    Application.DisplayAlerts = False
    newWorkbook.Sheets(1).Delete
    Application.DisplayAlerts = True

    ' VBAプロジェクトのコピー
    On Error Resume Next
    For Each vbComp In sourceWorkbook.VBProject.VBComponents
        ' 標準モジュールのコピー
        If vbComp.Type = vbext_ct_StdModule Then
            modName = vbComp.Name
            sourceWorkbook.VBProject.VBComponents(modName).Export _
                Environ("TEMP") & "\" & modName & ".bas"
            newWorkbook.VBProject.VBComponents.Import _
                Environ("TEMP") & "\" & modName & ".bas"
            Kill Environ("TEMP") & "\" & modName & ".bas"
        End If
        
        ' クラスモジュールのコピー
        If vbComp.Type = vbext_ct_ClassModule Then
            modName = vbComp.Name
            sourceWorkbook.VBProject.VBComponents(modName).Export _
                Environ("TEMP") & "\" & modName & ".cls"
            newWorkbook.VBProject.VBComponents.Import _
                Environ("TEMP") & "\" & modName & ".cls"
            Kill Environ("TEMP") & "\" & modName & ".cls"
        End If
        
        ' ユーザーフォームのコピー
        If vbComp.Type = vbext_ct_MSForm Then
            modName = vbComp.Name
            sourceWorkbook.VBProject.VBComponents(modName).Export _
                Environ("TEMP") & "\" & modName & ".frm"
            newWorkbook.VBProject.VBComponents.Import _
                Environ("TEMP") & "\" & modName & ".frm"
            Kill Environ("TEMP") & "\" & modName & ".frm"
        End If
        
        ' ワークシートやThisWorkbookモジュールのコードのコピー
        If vbComp.Type = vbext_ct_Document Then
            Set vbCompDest = newWorkbook.VBProject.VBComponents(vbComp.Name)
            vbCompDest.CodeModule.DeleteLines 1, vbCompDest.CodeModule.CountOfLines
            vbCompDest.CodeModule.AddFromString vbComp.CodeModule.Lines(1, vbComp.CodeModule.CountOfLines)
        End If
    Next vbComp
    On Error GoTo 0

    ' イベントを再有効化
    Application.EnableEvents = True
    Application.ScreenUpdating = True

    ' 新しいブックを保存(.xlsm形式で保存)
    newWorkbook.SaveAs "安全コピーされたブック.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
    newWorkbook.Close
End Sub

Microsoft Visual Basic for Applications Extensibility 5.3を有効にする

モジュールなどをコピーするときに必要な設定です。

STEP
ツールタブ ⇒ 参照設定
STEP
Microsoft Visual Basic for Applications Extensibility 5.3 にチェックを入れる

シートのオブジェクト名を変更するための設定変更

シートのオブジェクト名を変更するためには、下記の記事の設定変更が必要です

コードのポイント

数式参照の修正:

シートのコピー後、newSheet.UsedRange内のすべてのセルについて、まず数式を文字列に変換して保存し、その後再度数式に戻す処理を行います。これにより、元のブックへの不正な参照が排除されます。

イベントと画面更新の無効化:

コピー時のパフォーマンスと信頼性を確保するために、Application.EnableEventsApplication.ScreenUpdatingを無効化します。最後に再度有効にします。

シートにあるオブジェクト

シートにあるオブジェクトは、コピー時によくエラーが発生しますので、エラーハンドリングでスキップすることで止まることを回避しています。なので、コピーされていないオブジェクトがあるかもしれません。

まとめ

Excelが不安定になってきて、新しいブックに移行させるために役立つコードをご紹介しました。

Excelはとても便利ですが、たまーに不安定になったりするので、ぜひお試しください。

記事を書いた人

稲垣

  • Excel、ACCESSでのシステム開発が得意
  • ITスキルを共有し実践的に学びながら成長する人を見るのが幸せ
  • 自家焙煎するほどのコーヒー好き
  • 使用言語 VBA、Python、Javascript、Java、HTML、CSS etc.
  • 保有資格 Kintoneアソシエイト、日商簿記検定2級、マンション管理士、管理業務主任者、情報セキュリティマネジメント、ExcelVBA etc.
  • 業務フロー図の作成や業務時間分析を通して、効率化ポイントを探る人
  • お客様にとって本当に良いことかを第一に考える人
よかったらシェアしてね!
  • URLをコピーしました!
  • URLをコピーしました!

コメント

コメントする

目次