シート シート新ブック保存
※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。
※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。
Public Sub シート新ブック保存(TagetBook As Workbook, TagetSheet As Worksheet, FolPath As String, ファイル名 As String) '******************************************************************************* '指定シートを新しいブックに保存（指定フォルダへ）必ずシート名は[Sheet1]にする '******************************************************************************* Dim NewBook As Workbook, strName As String, NewSheet As Worksheet strName = 保存名作成 Set NewBook = Workbooks.Add Dim i, cnt As Integer cnt = NewBook.Sheets.Count For i = 1 To cnt If NewBook.Sheets(i).Name = "Sheet1" Then NewBook.Sheets(i).Name = "Sheet0" Exit For End If Next TagetSheet.Copy Before:=NewBook.Sheets(1) Set NewSheet = NewBook.Sheets(1) NewSheet.Name = "Sheet1" Call シート削除(NewBook, "Sheet0") ' MsgBox FolPath & "\" & ファイル名 & "_" & strName & ".xls" ' MsgBox InputBox("", "", FolPath & "\" & ファイル名 & "_" & strName & ".xls") ' NewBook.SaveAs Filename:= _ ' FolPath & "\" & ファイル名 & "_" & strName & ".xls" ', FileFormat:= _ ' xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _ ' , CreateBackup:=False NewBook.SaveAs Filename:=FolPath & "\" & ファイル名 & "_" & strName & ".xls" NewBook.Close Set NewSheet = Nothing Set NewBook = Nothing MsgBox "保存完了しました。", vbInformation, "保存完了" End Sub |