シートを分割して保存

Sub 分割()
Dim i As Integer
Dim N As Integer 'ファイル作成数のカウンタ
Dim Filename As String '保存するファイル名

Application.ScreenUpdating = False '画面更新停止


For i = 1 To Worksheets.Count
Filename = Worksheets(i).Name 'シート名
Worksheets(i).Copy
With ActiveWorkbook
't = Format(Now, "mm月dd日")
t = Range("b4").Value
.SaveAs ThisWorkbook.Path & "\" & Filename & t & ".xls", FileFormat:=XlFileFormat.xlExcel8
'元ファイルと同フォルダにtの情報をつけて保存する
.Close
End With

Next i

Application.ScreenUpdating = True '画面更新再開
MsgBox "終了 。"
End Sub
スポンサーサイト

コメントの投稿

非公開コメント

プロフィール

とも

Author:とも
FC2ブログへようこそ!

最新記事
最新コメント
最新トラックバック
月別アーカイブ
カテゴリ
FC2カウンター
検索フォーム
RSSリンクの表示
リンク
QRコード
QR