マクロでシートを削除する方法

このQ&Aのポイント
  • WINDOWS7 EXCELL2010を使用している場合、シートを削除するためのマクロを作成する方法を教えてください。
  • シート名一覧として参照図に表示されているシート名の一覧を作成するためのマクロを使用して、指定したシートを削除する方法を教えてください。
  • シート名一覧のA列にシート名が表示され、B列に○を入れることで、そのシートを削除できるマクロについて教えてください。
回答を見る
  • ベストアンサー

不特定のシートをマクロで削除を ~2

いつもお世話になります WINDOWS7 EXCELL2010 です。 御指導を仰ぎたいのは、 参照図で言いますとシート名「シート名一覧」のA列に下記のマクロで抽出されたシート名の一覧があります。 このシートのB列に削除したいシートに○(例えばB16 B17)を入れるとマクロでそのシートが削除されるマクロが可能であれば是非ご教授いただけませんでしょうか。 抽出するマクロは下記です。 Sub アクティブセルからシート名一覧を作成する() Dim sh As Object Dim row_num As Long Dim col_num As Long If MsgBox("アクティブセルから下にシート名一覧を作成してもいいですか?", vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub row_num = ActiveCell.Row col_num = ActiveCell.Column For Each sh In ActiveWorkbook.Sheets Cells(row_num, col_num).Value = sh.Name row_num = row_num + 1 Next sh End Sub 宜しくお願いいたします。

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

  • ベストアンサー
  • keithin
  • ベストアンサー率66% (5278/7940)
回答No.1

sub macro1()  dim h as range  set h = range("B:B").find(what:="○", lookin:=xlvalues, lookat:=xlwhole)  application.displayalerts = false  do until h is nothing   worksheets(cells(h.row, "A").text).delete   h.entirerow.delete shift:=xlshiftup   set h = range("B:B").findnext()  loop  application.displayalerts = true end sub #ナンか言うと,またプイッと閉じ逃げされちゃうんだろうなぁ。。

dorasuke
質問者

お礼

早速ご指導いただきありがとうございました。 御迷惑掛けたならお許しください。 早速使わせていたたきました。 上手くできました。 感謝感激です。 今後ともこれに懲りずに御指導くださいませ。

dorasuke
質問者

補足

先回の御指導の中に下記のようなメッセージがありまはたね。 私なりの理解は 私が考えたのが良くなく別の案で何かいい方法があったらと思ったのです。 そう言う意味では 3個の質問になり御迷惑掛けたかなと考え又下記のこともあって再投稿しました。 誤解して再投稿したことが悪ければ素直に謝ります。 お許しください。 一度ご相談は解決で閉じてから、改めて「こういう結果が欲しい/こうなって欲しい」とご相談を書き直し、新しく投稿しなおしてみて下さい。 申し訳ありませんが閉じ逃げなんかの気持ちは毛頭ありません。 いつもここではお世話になっています。 もしそう思われていたら反省するところです。 #ナンか言うと,またプイッと閉じ逃げされちゃうんだろうなぁ。。

関連するQ&A

  • 不特定のシートをマクロで削除を

    いつもお世話になります WINDOWS7 EXCELL2010 です。 シート「記入」にデーターを入力してそのデーターをいくつかの振分のシートに転記しています。 条件 削除したい 1 0000    の4桁のシート名のいずれかのシートを削除   ※例えば 11月4日のシート名は 1104 の4桁になります。         1月1日は 0101 となります。        今月で言えば 1101 ~ 1130 の30枚のシートがあります。 削除しない 1 文字名   のシートは削除しない 2 1 ~ 12 のシートは削除しない 上記の削除したいの方法は私なりの考えで2通り考えました。 他にいい方法があればおすすめ願えればありがたいです。 その1~ 00 の4桁のシート名が削除の対象ですので、 例えば今月で言いますと ~1031(10月31日分) 先月までのシートをマクロで削除する方法 その2~      添付図のようにB列に○のあるシートのみをマクロにて削除する方法 抽出するマクロは下記です。 Sub アクティブセルからシート名一覧を作成する() Dim sh As Object Dim row_num As Long Dim col_num As Long If MsgBox("アクティブセルから下にシート名一覧を作成してもいいですか?", vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub row_num = ActiveCell.Row col_num = ActiveCell.Column For Each sh In ActiveWorkbook.Sheets Cells(row_num, col_num).Value = sh.Name row_num = row_num + 1 Next sh End Sub 小生の考えの その1~ その2~ または他の方法でいいアイディアがありましたら御指導いただけませんでしょうか。 宜しくお願いします。

  • マクロ!一覧から別シートへの抽出

    商品の納期や、集金日などが一覧になっている【一覧】シートがあります。 他に集金月別にシート【4月】【5月】…と一年分12シートあります。 一覧シートは、空欄セルに店舗名や納期などを随時入力していき、データは増えていくのみです。 下記のマクロでデータの抽出・抽出結果のコピー・貼り付けを行っています。 Sub Macro4() ' ' Macro4 Macro ' 集金月で抽出 Dim myRow1 As Long, myRow2 As Long myRow1 = Sheets("一覧").Range("B65536").End(xlUp).Row myRow2 = Sheets("4月").Range("B65536").End(xlUp).Row If myRow2 >= 3 Then ★ Sheets("4月").Range("A3:P" & myRow2).ClearContents End If Sheets("一覧").Range("A3:P" & myRow1).AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("G1:H2"), CopyToRange:=Range("A4:P4"), Unique:=False End Sub 一覧以外のシート全てに、上記マクロを登録した【抽出】ボタンを設置し G1:H1セルには集金日と検索項目のタイトル G2セルには>=4/1、H2セルには<=4/30 抽出ボタンをクリックして一覧から取得しています。  マクロは、説明が載っているHPからの独学なのでどう応用すれば良いのかがわかりません。 一覧に追加入力し、4月シートに4月分抽出。次に5月シートに5月分抽出とすると4月シートの抽出結果が消えてしまいます。 そこで、★で指定している4月シートではなく、現在選択している”シート”としたいのですが、どのように記述すればよいかわかりません。 自分が分からない事を、どう検索してよいかも分からなくなってきたので、どうかアドバイスお願いします。

  • シートの全てを半角にする

    A列からT列、 行は10000行ほどあるのですが 全てを半角にしたいのですがマクロでないと無理でしょうか? Sub 全てを半角にする() Dim row行 As Long Dim col列 As Long For col列 = 1 To Range("IV1").End(xlToLeft).Column For row行 = 2 To Cells(65536, 2).End(xlUp).Row Cells(row行, col列) = StrConv(Cells(row行, col列), vbNarrow) Next row行 Next col列 End Sub でやるしかないですか? もっと効率のいい方法があったら教えてください!

  • エクセルのマクロで特定フォルダ内のJPGファイルを検索して開きたいので

    エクセルのマクロで特定フォルダ内のJPGファイルを検索して開きたいのですが、うまくいきません。 検索して開くファイルは、アクティブセルの値で始まります。 (例えばアクティブセルが「0000」だとすると、フォルダ内にある「0000りんご.JPG」というファイルを開く。りんごの部分は特定の文字でないためワイルドカードを使用してみましたがうまくいきません) Sub test() Dim P As String Dim Fname As String Fname = ActiveCell.Value P = "パス名\" & Fname & "*.JPG" Shell "Rundll32.exe" & " Shimgvw.dll,ImageView_Fullscreen" & " " & P, vbNormalFocus End Sub どうぞよろしくお願い致します。

  • 特定の文字を含むシートを選択するには

    いつもお世話になっております。 特定の文字を含むシートのデータをコピーするにはどのようにしたらよろしいでしょうか。 具体的には (1)シート名の末尾に"D"を含むシートを選択 (2)選択したシートのデータをコピー (3)コピーしたデータを順次"Sheet1"に貼付 というマクロを組みたいのですが、(1)のところがうまくいきません。 以下のように作成してみました。 Dim sh As Worksheet Dim lr As Long, tlr As Long For Each sh In Worksheets If sh.Name = "*D" Then lr = sh.Cells(ActiveSheet.Rows.Count, 3).End(xlUp).Row sh.Rows("3:" & lr).Copy tlr = Sheets("Sheet1").Cells(ActiveSheet.Rows.Count, 3).End(xlUp).Row Sheets("Sheet1").Range("A" & tlr + 1).PasteSpecial End If Next 4行目の sh.Name = "*D" のところがうまくないようです。 よろしくお願いします。

  • マクロ シート削除の記述確認願います

    いつも回答して頂き、感謝しています。 ネットで調べながら、使えそうな記述を少し修正し、シート削除のマクロを記述してみました。 削除するシートの対象は、別のシートに一覧で載せてあります。 ちなみに、シートを挿入する時も、上記で参照する一覧を参照して作ってあります。 こんな場合もあるから、こんな感じに記述した方がいいよって意見がありましたら、教えてください。宜しくお願い致します。 Sub 作業名別のシートを削除する() Dim h As Range On Error Resume Next Application.DisplayAlerts = False With Worksheets("作業名一覧") .Activate For Each h In .Range(.Range("B2"), Range("B65536").End(xlUp)) Worksheets(h.Value).Delete Next End With Application.DisplayAlerts = True End Sub

  • EXCELマクロでシート作成&シート名をつける方法

    EXCELでセルK列に入力した名称でシートをどんどん作成したいのですが、 下記のようにやってみましたが、うまく実行されません。 2回目の←の部分で、終わってしまいます。 詳しい方、教えてください。 Sub Macro3() Dim neSheet As String Dim fMax As Integer Dim num As Integer Dim i As Integer fMax = Range("B2").Value num = 2 For i = 1 To fMax neSheet = Range("k" & num).Value Worksheets.Add(After:=Worksheets(1)).Name = neSheet ← num = num + 1 Next i End Sub

  • 同じシート名を一枚にまとめる

    エクセルのマクロでファイル内の同じシート名を一枚にまとめたい。 シート名が"売上"、"売上(2)"、"売上(3)"・・・ のようになっていて、売上シートの枚数は変動します。 他にも、、"部署"、"部署(2)"、"部署(3)"・・・・ のようにシート枚数が変動します。 売上、部署シートの1行目はタイトル行になっています。 そして、BOOK内には、他にもシートがいくつかあります。 BOOK内の "売上"シート名を一枚にまとめ、 "部署"シート名を一枚にまとめる方法をどうかご教授願います。 複数のBOOKから一つのファイルにまとめる事が出来たのですが、 どうやっても、同じシート名同士だけをまとめるマクロが出来ず、 とても困っています。 どうか、助けて頂けないでしょうか? 何卒お願い致します。 ちなみに、 下記は途中で断念した案の一つです。 統合表シートを売上シートが隣に並ばないといけないのと、 売上、売上(2)も隣に並ばないと動かないのと 部署(2)、部署(3)・・・もまとめてしまうから、 駄目でした。 とりあえず、売上だけはまとめようとしました。 下記のコードには、こだわりませんので、助けてください。 お願いします。 Sub まとめ() Dim sh1 As Worksheet Dim sh2 As Worksheet Dim j As String Dim d As String Dim i As Integer Set sh1 = Worksheets("統合表") j = 2 '統合表のデータ書きこみ開始行 For Each sh2 In ActiveWorkbook.Worksheets If sh2.Name = "発注" Or _ sh2.Name = "部署" Or _ sh2.Name = "使い方" Or _ sh2.Name = "残すシート" Then Exit For '統合表は統合対象外 d = sh2.Range("A65536").End(xlUp).Row '各シートの最終行を知る ' MsgBox d For i = 2 To d sh1.Cells(j, "A") = sh2.Cells(i, "A") sh1.Cells(j, "B") = sh2.Cells(i, "B") j = j + 1 Next i Next End Sub

  • 【マクロ】全シートでまとめて実行するには?

    教えてください。マクロは初心者です。 ↑先ほど、http://oshiete1.goo.ne.jp/qa5695407.html で、ある親切な方に以下のマクロを教えて頂きましたが、私がその時にまとめて聞くのを忘れてしまい、改めて教えていただきたく思います。 ------------------------------------------------ Sub test()  Dim R As Long  For R = 1 To Cells(Rows.Count, "B").End(xlUp).Row    If Cells(R, "B").Value = "土" Or CellsR, "B").Value "日" Then      Cells(R, "A").Resize(1, 5).Interior.ColorIndex = 6    End If  Next R End Sub ---------------------------------------------------- 上記のマクロを1シートでなく、全シートでまとめて実行したいのですが(どのシートも同様の内容なので)、どうすればいいのかわかりません。 どの個所にどんなコードを入れればよいのでしょうか? よろしくお願いします。 【XP、2003】

  • Excel 改ページのマクロ

    同シート内で改ページを設定するマクロを、ここで教えてもらったのですが、改ページを判断するデータの列が関数(vlookup)で持ってきたデータの場合にうまく機能しません。下のマクロに手を加えれば可能でしょうか? Sub Macro4() Const col As String = "A" '改ページを判断するデータの列名 Dim idx As Long Dim sv sv = Cells(1, col).Value For idx = 1 To Cells(65536, col).End(xlUp).Row   If Cells(idx, col).Value <> sv Then     ActiveSheet.HPageBreaks.Add Before:=Rows(idx)     sv = Cells(idx, col).Value   End If Next idx End Sub

専門家に質問してみよう