ブックをコピーするVBA

Sub ブック作成()
    Dim 元ブック As Workbook
    Dim 元シート As Worksheet
    Dim 対象シート As Worksheet
    Dim 新ブック As Workbook
    Dim ファイルパス As String
    
    ' 元のブックを設定
    Set 元ブック = ThisWorkbook
    
    ' シート6のA1セルの値を取得
    Dim 新ブック名 As String
    新ブック名 = 元ブック.Sheets(1).Range("A1").value
    
    ' 新しいブックを作成
    Set 新ブック = Workbooks.Add
    Set 対象シート = 新ブック.Sheets(1)
    
    ' 元のシートの内容を新しいブックにコピー
    For Each 元シート In 元ブック.Sheets
        If 元シート.Index <> 1 Then ' シート1以外の場合にコピー
            元シート.Cells.Copy 対象シート.Cells
            ' 次のシートに移動
            If 元シート.Index < 元ブック.Sheets.Count Then
                Set 対象シート = 新ブック.Sheets.Add(After:=対象シート)
            End If
        End If
    Next 元シート
    
    ' 新しいブックの名前を設定して保存
    新ブック.SaveAs 元ブック.Path & "\" & 新ブック名 & ".xlsx", FileFormat:=51 ' xlsxフォーマットを指定
    
    ' 新しいブックを閉じる
    新ブック.Close SaveChanges:=True
    
    ' メッセージを表示
    MsgBox "新しいブックが作成されました。", vbInformation
    
End Sub