VBA データ左側から3文字で分類し新規シート転記

質問

お知恵を貸して下さい。
エクセルに入力された問合せ内容をまとめていく上で困っています。
２列目の会員種別に入力されているデータがくせ者で、左側ら3文字で会員の種類が分かれます。

やりたい仕事は、この会員種別ごとに新規でシートを起こし、3文字mmというタイトルで（mmは上書きで書き換えます）保存までを自動化でしたいのです。
その際、元のデータから特定のセルを選んで転記するのではなく、あくまで会員種別の左から3文字で仕分けます。行は丸ごとコピーする必要があります。

新規シートでシート名までを自動で作成したいのでVBAかと思いまして。

どなたか助けて下さい、宜しくお願いします。

回答No.1

keithin · ベストアンサー

１行目はタイトル行，２行目から実データとして。
会員種別がＢ列に列記されているとして。
（といったような具体的なあなたのシートのレイアウトは，そもそもご相談であなたの方から提示してください）

sub macro1()
　dim h as range
　dim w as worksheet
　dim s as string
　s = activesheet.name

’転記する
　on error goto errhandle
　for each h in range("B2:B" & range("B65536").end(xlup).row)
　　h.entirerow.copy destination:=worksheets(left(h, 3)).range("A65536").end(xlup).offset(1)
　next
　on error goto 0

’保存する
　for each w in worksheets
　　if w.name <> s then
　　　w.copy
　　　activeworkbook.saveas filename:="c:\test\" & activesheet.name & "mm.xls"
　　　activeworkbook.close savechanges:=false
　　end if
　next
　exit sub

’シートを新調する
errhandle:
　worksheets.add after:=worksheets(worksheets.count)
　worksheets(s).range("1:1").copy destination:=activesheet.range("A1")
　activesheet.name = left(h, 3)
　resume
end sub

お礼

いつもお世話になってます。
説明不足の件、ご指摘ありがとうございました。以後、改めます。

さっそく、作成していただいたもので使用してみました。
新規シートのシート名が仕分けた頭３文字になっていました。

しかし、途中でエラーが出てしまい、新規ブックが開いた状態のまま何も表示されていませんでした。
終了ではなく、デバッグを選ぶと、下記の部分が黄色く選択されておりました。

>activeworkbook.saveas filename:="c:\test\" & activesheet.name & "mm.xls"

どのように理解すればよいか、お知恵を貸してください。
よろしくお願いします。

回答No.2

keithin

＞途中でエラーが出てしまい、新規ブックが開いた状態のまま何も表示されていませんでした。

当該のブックに，元データのシートでもなくABCシートでもない，空っぽの例えばSheet2などがある状態でマクロを実行しているのではないかと推測されます。
元データのシートが１枚あるだけの状態から，再度マクロを実行してください。

＞終了ではなく、デバッグを選ぶと、下記の部分が黄色く選択されておりました。

これは説明不足だったかもしれません。失礼しました。
「どこに」保存したいのかなんの説明もありませんでしたので，マクロには仮にCドライブにtestというフォルダがあってその中に保存するように書いてあります。
testというフォルダの用意が無いと，エラーになります。
もしくは，あなたが実際に保存したい場所に保存するよう，マクロをご自分で修正していただかなければいけません。

お礼

シートの件も、保存先の件も全てクリアになりました。
いつも助けていただき、ありがとうございます。

今後は説明も工夫して投稿します。
本当にありがとうございました！！！