• ベストアンサー

シート作成毎の削除方法

30枚シートを作成し5シート毎に新規ブックで保存をし、アクティブシートに新規で保存した分は 削除し、新たに5シート毎に新規ブックで保存し。。を繰り替えし30枚シートを6ブックに分けたいのですが うまくいきません。 初めにインデックスを作成しているのでワークシートa以降から5シート毎に削除したいのですが・・ 下記のプログラムをループの中に入れて実行させたいのですが、'★からの命令でaシート以降5シート毎に削除 したいのですが削除すらできません。。 何かアドバイスがありましたらお願い致します。               list_cnt = list_cnt + 1 If list_cnt = 5 Then ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "【●●】分析資料.xls" ’★ ActiveWorkbook.Worksheets.Delete After:=Worksheets("a") End If

質問者が選んだベストアンサー

  • ベストアンサー
  • n-jun
  • ベストアンサー率33% (959/2873)
回答No.2

後ろから5枚ずつを5つのブックに分けます。 ⇒残った5枚を移動させるの・・・? Sub try()  Dim i As Integer, j As Integer  Dim v(4) As Variant  Application.ScreenUpdating = False  For i = 5 To 1 Step -1      For j = 0 To 4          v(j) = i * 5 + (j + 1)      Next      ThisWorkbook.Worksheets(v).Move      ActiveWorkbook.Close True, Filename:=ThisWorkbook.Path & "\○○_" & i & ".xls"  Next  Application.ScreenUpdating = True End Sub 一旦配列変数:vにシートインデックスNoを代入し5枚毎にMove(移動)させ、 新しいブックに重複しないようファイル名を変えながら保存してます。 ご参考になれば。

全文を見る
すると、全ての回答が全文表示されます。

その他の回答 (3)

  • n-jun
  • ベストアンサー率33% (959/2873)
回答No.4

n-junです。 >30枚シートを作成し5シート毎に新規ブックで保存をし、 #2のコードは”30シート出来ている”状態の物ですので、作成からであれば ・・・ちょっと的はずれかも。

全文を見る
すると、全ての回答が全文表示されます。
  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.3

5シートはどういう風に決定するのか、しっかり書かないと、解答しようが無い。 (1)シートタブの左から見えている順 シートの「インデックス番号の1-5、6-10、・・ ということになる。 (2)シートの名前がa1,a2,a3,a4,a5,b1,b2,b3,b4,b5・・・ などと在って、aのシート5つ、bのシート5つという風にまとめるのか。この場合、サブ番号数字の判別など結構複雑と思う。 (3)その他のまとめ方か ーー 削除については この質問の5ブックに5シートずつ保存して、1つのシートを残し(エクセルでは1つは必要)他を削除してはダメですか。 下記は削除する処理のみ Sub test01() Application.DisplayAlerts = False Sheets.Add For i = 2 To Sheets.Count Sheets(2).Delete Next i Application.DisplayAlerts = True End Sub ーー 質問の重点が シートの5シートづつ分割にあるのか シートの削除にあるのか はっきりしない。 --- >初めにインデックスを作成しているのでワークシートa以降から5シート毎に削除したいのですが・ >インデックスを作成しているので >a の意味もわかりにくい。突然aとは何。

全文を見る
すると、全ての回答が全文表示されます。
  • fujillin
  • ベストアンサー率61% (1594/2576)
回答No.1

ワークシートの後ろから5シートを削除したいのですよね?  Application.DisplayAlerts = False  For i = 1 To 5   ActiveWorkbook.Worksheets(Worksheets.Count).Delete  Next i  Application.DisplayAlerts = True とかではどうでしょうか? (まとめて指定して消去するのもありだろうけど、同じようなものなので…) なお、直接の御質問内容ではありませんが、  Filename:=ThisWorkbook.Path & "【●●】分析資料.xls" は、思ったとおりのパス(ファイル名)になっていますか? (\をつけなくてもいいのかな?) …というか、毎回同じ名前で上書きしてたりしませんか?

全文を見る
すると、全ての回答が全文表示されます。

関連するQ&A

  • Excelシート1シートのみを指定フォルダへ保存

    Excelのシート1のみを、本日の日付と名前の入ったセル(I7)を保存する時の名前にして指定したフォルダへ保存したいと思っています。 1、シートは本日の日付+I7セルに入っている値を名前にする。 2、フォルダはCではなくV:\○○\○○\○○\○○\○○\○○\○○に格納 3、シート1以外のシート2、シート3は保存せず閉じる 4、格納後○○に保存しました。と表示 試行錯誤し、下記のように記述してみたのですが、 Sub Macro1() 'Option Explicit Sub Sample() Dim xSheet As Worksheet Dim myFile As String Dim myName As String Set xSheet = ActiveSheet ThisWorkbook.Worksheets("シート名").Copy 'myName = ActiveWorkbook.Worksheets(1).Name 'myFile = ThisWorkbook.Path & "\" & myName & ".xls" myFile = ThisWorkbook.Path & "\" & xSheet.Range("I7").Value & ".xls" Application.DisplayAlerts = False ActiveWorkbook.SaveAs Filename:=myFile Application.DisplayAlerts = True ActiveWorkbook.Close End Sub 日付を指定して保存 Sub test()  Dim Filename As String  Filename = Format(Date, "yyyy年mm月dd日") & ".xls"  ActiveWorkbook.SaveAs "C:\My Documents\" & Filename End Sub 日付とI7セルの名前を合せてブックの名前としたい場合どうVBEで記述すればいいのかわからないので詳しい方がおられましたら、 よろしくお願いいたします。 あまり詳しくないので、そのままコピーできるか、○○の部分を指定フォルダ名に変えてください。等の注釈を付けていただけると助かります。

  • Excelで最終行の空白を削除にする

    ExcelのVBAでつまづいています。 以下のようにコードを書きました。 Sub Auto_Close() Worksheets("Sheet1").Select 'シート1を開く If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData End If 'フィルタをすべてチェックする Filename = Format(Now(), "yyyy-mm-dd-hh-mm-ss") ThisWorkbook.SaveAs Filename:="\\●●●●\●●●●\●●●●\●●●●\●●●●\" & Filename & ".xlsm" 'Excelデータをバックアップ ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select '一番左下の空白セルに移動 ActiveWorkbook.Save '開いているセルを上書き保存 End Sub 次に開いたときにはA列最終行の空白がアクティブになっているはずなのですが、うまくいきません。 バックアップのコードを削除するとうまくいくのですが、なぜそうなるのか意味がわかりません。 どこがおかしいですか?

  • 別ブックにして保存する際、関数が設定してあるためデータが参照できなくなります。

    別ブックにあるシート(元シート)をコピーしていますが、そのシートは他のシートから関数を入れて参照しているため、別ブックにするとデータがおかしくなります。すべて値にして別ブックにするにはどのようにしたらいいでしょうか? いま書いているコードは次のように書いています。 Sub 保存() Application.ScreenUpdating = False Worksheets("元").Copy ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" _ & Range("A1").Text & "-" & Range("F2").Text & "・" & Range("J2").Text & ".xls" Application.ScreenUpdating = True End Sub

  • 【VBA】シート順番に新規ブックにコピーする方法

    いつもこちらの識者の皆様にはお世話になっております。 VBAのことで質問させてください。 ブックに、 "入力用","りんご","ばなな","みかん" のシートがあります(シートは今後増える可能性があります) このうち、"入力用"以外のシートに下記の処理をしたいのです。 1.1シートごとに新規でブックを作成し、データを値で貼り付ける。 2.ファイル名を"シート名" + mmdd形式でC:\aaa\に保存する(ex.C:\aaa\りんご0513.xls)  このときできれば、シートはコピーしてきた1つだけにするのが望ましいです。 作りかけのコードは下記です。 -------------------------------------------------------------- Sub test() Dim objSh As Object For Each objSh In ActiveWorkbook.Sheets If objSh.Name <> "入力用" Then objSh.Select ThisWorkbook.ActiveSheet.Copy '関数が残っているので値で貼り付けたい ActiveWorkbook.SaveAs Filename:="" 'コード不明 End If Next End Sub -------------------------------------------------------------- 分からない点は 1.ThisWorkbook.ActiveSheet.Copyで新規ブックにシートをコピーすることはできたのですが、 関数が残ってしまっているので、値で貼り付けたい。 2.シート名を取得して、ファイル名に反映する方法がわからない。 です。 どなたか、上記内容の場合どのようなコードが適しているか教えていただけませんでしょうか。 よろしくお願いいたします。

  • VBA SaveAsでワークシートの指定する時

    以下は自動マクロで作成したものをちょっと変えたものです。 Sub Macro1() Sheets(1).Select Sheets(1).Copy ChDir "C:\" ActiveWorkbook.SaveAs Filename:="C:\Book2.xlsx", _ FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False Windows("Book2.xlsx").Activate ActiveWindow.Close End Sub 内容: 一番左のシートのみBook2.xlsxに保存する 疑問点: シートをコピーした後、SaveAsコマンドで保存する際に「コピーしたシートのみ保存する」ような記述が見られないことです。SaveAs自体が、コピーされたシートのみ保存すること前提のメソッドなのでしょうか? ちなみに、Sheets(1).Copyを削除するとブック全体を保存します。

  • 新しく作成したBOOKを上書き保存

    いつも大変お世話になっております。 新規作成したBOOKを指定の場所に、指定の名前で保存しようとしています。 例)C:\ファイル名.xls 保存したいものの sFileName="C:\ファイル名.xls" WorkbookName="ファイル名.xls" ActiveWorkbook.SaveAs Filename:=sFileName '保存して閉じる Workbooks(WorkbookName & "_" & sNowTime & ".xls").Close SaveChanges:=True 上記のように設定したところ、 既にファイルがある場合はウィンドウが表示されます。 その際、MsgBoxにフルパスで表示されてしまい、大変見づらく困っています。 また、新規作成したブックは必ず上書き保存で良いものになっています。 C:\ファイル名.xls というものが既にある場合は、 メッセージを出さず、上書き保存にしたいと思っています。 下記のように、既にブックがあるかも確認したのですが、 違い?が良く分からず、上手くいきませんでした。 '======================使わない上に、プログラムが間違っているためコメントアウトしてます。=========-- 'Dim buf As String ' buf = Dir(sFileName) 'ファイルの存在を調べる ' If buf <> "" Then ' '保存 ' ActiveWorkbook.SaveAs Filename:=sFileName '保存して閉じる ' ' '=================ファイル作成完了 ' Else ' ActiveWorkbook.SaveAs Filename:=sFileName '保存して閉じる ' Workbooks(WorkbookName & "_" & sNowTime & ".xls").Close SaveChanges:=True ' End If '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 質問内容がぐちゃぐちゃしてきたので、まとめさせて頂きます。 ●新規ブックを指定場所に、指定名で保存したい ●指定場所に指定名のブックがあった場合、メッセージを出さずに上書き保存したい です、よろしくお願いいたします。

  • エクセルVBAについて

    <sheet1>フォーマット(コピーするシート) <sheet2>    A列    B列 ○○支店  15 △△支店  10 ××支店  28 ■■支店  25 ◎◎支店  18 sheet1のフォーマットをsheet2のB列の数コピーして、sheet2のA列の支店別に新しいブックへ保存するという作業のマクロを組みたいのですがどのようにしたらよいでしょうか?お教えください。VBAに関しまして初心者で、勉強しているのですがいまいちわかりません。どうぞよろしくお願いします。 今、一つだけコピーして保存するということはできていますが、上記のように全部を自動的にしたいのですが・・・ Sub グラフをコピーして別ブックへ保存() Dim mySheet As Worksheet Set mySheet = ActiveWorkbook.Worksheets("グラフ") mySheet.Copy ActiveWorkbook.SaveAs Filename:="大阪第一" '別名を付けてブックを保存する ActiveWorkbook.Close '別名ブックを閉じる End Sub よろしくお願いします。

  • ブックCloseでVBAが続かない

    エクセル2002を使用しています ブック(A)をコピーして名前(B)をつけて別ブックで保存しました ブック(A)を呼び出し後、ブック(B)を閉じてブック(A)のVBAを継続したいのですが 継続しません 作成したモジュールは以下です   Application.DisplayAlerts = False   '【不要なシートを削除する】 Sheets(Array("注文書入手差異表", "入手予定履歴", "main", "営C")).Select ActiveWindow.SelectedSheets.Delete   '【ThisWorkbook.Pathの『注文書確認フォルダ』の中に、名前をつけて別ブックで保存する   '   …ユーザーフォームを使用するのでマクロごと保存】 Dim myFolder As String Dim Filename As String myFolder = ThisWorkbook.Path & "\注文書確認フォルダ" Filename = Format(Date, "yyyymmdd") & "注文書入手予定表" If Dir$(myFolder, vbDirectory) = "" Then MkDir myFolder End If ActiveWorkbook.SaveAs Filename:= _ myFolder & "\" & Filename Application.DisplayAlerts = True '【保存した別ブック名を再取得】 Dim myName0 As String myName0 = ThisWorkbook.Name   '【コピー元のファイルを開く】 Dim myPath As String myPath = Application.Substitute(ThisWorkbook.Path, "\注文書確認フォルダ", "") Workbooks.Open (myPath & "\" & "注文書入手予定表")   MsgBox "【注文書確認フォルダ】の中に別ブックが作成されました"     '【保存した別ブックを閉じる】 Workbooks(myName0).Activate Windows(myName0).Activate ActiveWorkbook.Close '******下のマクロが続かない***************** '====================== Call Macro6 '======================   VBA ステップインで原因を探ろうとしたのでですが   「中断モードでは入力できません」のメッセージがでて   デバッグができません   八方ふさがりの状態です。助けていただけませんか。

  • 【EXCELマクロ】空白のセルを削除する

    質問させてください。 ある特定のセルのみなにも記述されていない場合に削除するマクロを作成したいと思っております。 以下のようにコードを書いたのですがセルが削除されません。 知っていらっしゃる方いらっしゃいましたら教えていただけないでしょうか。 k = <<任意の数の場合>> If ThisWorkbook.Worksheets(<<【シートネーム】>>).Range("A" & k) = "" Then ThisWorkbook.Worksheets(<<【シートネーム】>>).Range("P" & k).Delete Shift:=xlToLeft End If If ThisWorkbook.Worksheets(<<【シートネーム】>>).Range("J" & k) = "" Then ThisWorkbook.Worksheets(<<【シートネーム】>>).Range("P" & k).Delete Shift:=xlToLeft End If                       : 削除後は左方向にシフトしたいと思っております。 以上、大変お手数をお掛けいたしますが宜しくお願い致します。

  • VBA シート名重複した場合削除する

    教えてください。 VBAに関しての質問です。 全くの知識がないので教えていただきたいです。 エクセルワークシートに以下の機能を追加している状態です。 For Each ws In Worksheets If ws.Name = "データ" Then wsChkflg = True End If Next If wsChkflg = True Then ThisWorkbook.Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = "データ" Else ThisWorkbook.Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = "データ" End If Set wsNew = ThisWorkbook.Worksheets("データ") 「データ」というシートが作成、追加されるのですが、同じシート名で新規作成した時に エラーが出てしまいます。そのエラーを出さないようにすため、ダイアログ等も出さずに既存のシートを強制的に削除する機能を追加したいのです。 VBAの知識がなくて困っています。 何か良い方法がわかる方いらっしゃいましたらお力を貸してください。 よろしくお願いいたします。