

Excelでシート毎に別ファイルにして保存する方法  
<https://incloop.com/excel%E3%81%A7%E3%82%B7%E3%83%BC%E3%83%88%E6%AF%8E%E3%81%AB%E5%88%A5%E3%83%95%E3%82%A1%E3%82%A4%E3%83%AB%E3%81%AB%E3%81%97%E3%81%A6%E4%BF%9D%E5%AD%98%E3%81%99%E3%82%8B%E6%96%B9%E6%B3%95/>

をみつけました。  
ファイル分割です。

①計算式を値に変換してからで十分です。  
②計算式のリンクで、できれば素晴らしい。  
よろしくお願いします。


CC BY-SA 4.0
2020-01-15T13:11:05.750
62267
2020-01-16T11:22:27.367
17199
question
vba excel
Excelでページ毎に別ファイルにして保存する方法を探しています。


改ページ位置は[HPageBreak](https://docs.microsoft.com/ja-
jp/office/vba/api/excel.hpagebreaks)および[VPageBreak](https://docs.microsoft.com/ja-
jp/office/vba/api/excel.vpagebreaks)で取得できます。  
ご質問のリンク先にあるサンプルコードを、改ページごとにファイルを作成するロジックに改造することで目的を達成可能と思います。

なおこの回答は[QAサイト](https://oshiete.goo.ne.jp/qa/1897074.html)を参考にしました。  
参考になった回答内容を引用します。

> どうしても改ページ位置取得なら、HPageBreakオブジェクトのLocationプロパティを使ってみたらどうでしょう。  
>  HPageBreaks（HPageBreakオブジェクトのコレクション）  
>  ActiveSheet.HPageBreaks.Count （改ページ総数）  
>  ActiveSheet.HPageBreaks(1).Location.Row （一番目の改ページの行）  
>  Location.Rowで改ページの行が分ります。

下記は改ページで出力先を分割し、"Sheet1_2_3.xlsx"のように改ページ座標付きのファイル名で出力するサンプルコードです。  
このまま使用すると計算式の参照先が失われたり座標がずれたりします。  
また挿入オブジェクトに対する挙動も未確認です。  
そのため出力元の内容を担保できませんのでご留意願います。。

必要に応じて値形式でセルの値を保持する作業用シートを作成するなど、要件に合わせて改修してみてください。

[code]

    Sub SheetSave()
        Dim wb1 As Workbook
        Set wb1 = ActiveWorkbook
        'シートの数だけ処理を繰り返す
        For i = 1 To wb1.Sheets.Count
            Set mySheet = wb1.Worksheets(i)
            Dim r1, r2, c1, c2 As Integer
            'ページ分割される行数分の処理を繰り返す
            r1 = 1
            For x = 0 To mySheet.HPageBreaks.Count
                c1 = 1
                If x = mySheet.HPageBreaks.Count Then
                    r2 = mySheet.UsedRange.Rows.Count + 1
                Else
                    r2 = mySheet.HPageBreaks(x + 1).Location.Row
                End If
                'ページ分割される列数分の処理を繰り返す
                For y = 0 To mySheet.VPageBreaks.Count
                    If y = mySheet.VPageBreaks.Count Then
                        c2 = mySheet.UsedRange.Columns.Count + 1
                    Else
                        c2 = mySheet.VPageBreaks(y + 1).Location.Column
                    End If
                    'シート名_x_y.xlsx の名称で保存
                    Dim fName As String
                    fName = mySheet.Name & "_" & CStr(x) & "_" & CStr(y) & ".xlsx" 
                    With Workbooks.Add
                        mySheet.Range(mySheet.Cells(r1, c1), mySheet.Cells(r2 - 1, c2 - 1)).Copy Destination:=.Sheets(1).Range("A1")
                        .SaveAs Filename:=fName
                        .Close
                    End With
                    c1 = c2
                Next y
                r1 = r2
            Next x
        Next i
    End Sub
    
[/code]


CC BY-SA 4.0
2020-01-16T11:22:27.367
62298
2020-01-16T11:22:27.367
9820
62267
answer