excel - Excel シートを複数のワークブックに分割する

Question

複数のシートを含む Excel ファイルがあります。ファイルごとに3枚ずつ、別々のファイルに分割したいと思います。

次のように新しい WorkBook を作成しました。

Set NewBook = Workbooks.Add
With NewBook
     .Title = "File1"
     .Subject = "File1"
     .SaveAs FileName:="File1.xls"
End With

シートを別のシートにコピーするにはどうすればよいですか?

Answer 1

このコードは

• ワークブックを一度に 3 シートのバッチの新しいワークブックに分割し、
• 以下の名前で新しいファイルとして保存します
• それらを閉じる

File1 (最初の 3 シート)
File4 (シート 4-6)
File7 (シート 7-9)

このコードは、Excel ファイルを余分なシートで「パディング」して、3 シート分割の複数を維持します。

を使用して新しいワークブックを作成できることに注意してください.Copy-使用する必要はありませんWorkbooks.Add

Code to be run from the Workbook to be split

Sub BatchThree()
    Dim lngSht As Long
    Dim lngShtAdd As Long
    Dim lngShts As Long
    Dim bSht As Boolean
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
    End With
    lngSht = 1

    'pad extra sheets
    If ThisWorkbook.Sheets.Count Mod 3 <> 0 Then
        bSht = True
        lngShts = ThisWorkbook.Sheets.Count Mod 3
        For lngShtAdd = 3 To (lngShts + 1) Step -1
            ThisWorkbook.Sheets.Add after:=ThisWorkbook.Sheets(Sheets.Count)
        Next
    End If

    Do While lngSht + 2 <= ThisWorkbook.Sheets.Count
        Sheets(Array(lngSht, lngSht + 1, lngSht + 2)).Copy
        ActiveWorkbook.SaveAs ThisWorkbook.Path & "/File" & lngSht
        ActiveWorkbook.Close False
        lngSht = lngSht + 3
    Loop

    'remove extra sheets
    If bSht Then
     For lngShtAdd = 3 To (lngShts + 1) Step -1
            ThisWorkbook.Sheets(Sheets.Count).Delete
        Next
    End If

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
    End With
End Sub

Answer 2

コピーを作成するための基本構文 (それが質問の場合):

Sub Make_Copy()
Thisworkbook.Sheets(1).Copy _
   after:=SomeWorkbook.Sheets(1)
End Sub

コピーの次に、当然シートの移動もできます。後ではなく前にコピーして、シートの名前を変更できます。