VBA：シートの追加とセルからの名前変更

質問

いつもお世話になっています。
ExcelのVBAで実装可能かと思うのですが、ご教授願いたく思います。

今回、大量のシートの追加（最後尾）とその追加したシートの名前を
変更するVBAを制作したいと思ったのですが

シートの追加とシートの名前変更（ソースの直接記入）までは、
なんとか出来ましたが
名前を、とある範囲のセルにある文字列に変更するという事がしたいです。

例えばE1:E5までの範囲にある文字列
「あ」
「い」
「う」
「う」
「う」
とあったら、かぶっているものは除き、「あ」「い」「う」という名前のシートを３つ追加したいという事です。

上記、もし実装可能であればご教授お願いします。
また、可能だけどokwaveの入力欄では面倒だし説明しづらい、という回答でもokです。
その場合、参考サイトなど教えて頂けると幸いです。

何卒よろしくお願いいたします。

回答No.4

keithin · ベストアンサー

＞にすればいいのですよね…？

えぇ，それでいいですよ。

と，正解だよと教えて貰ってからでないと，ご自分で試してみることもできないのですか？
それとも実際に「ジツは『これこれ』のマクロでやってみたらこういう具合に上手く行かなかったので教えて欲しかった」んでしたら，そういう具体的な状況をキチンと添えて新しいご相談として投稿し直してください。

＞不可視のセル

ついでに聞いちゃえで付き合わされるほうがイイ迷惑ですので，一つのご相談が解決したら新しい質問は次のご相談で投稿し直してください。こういうのは，こちらのような質問相談掲示板ではごくアタリマエのマナーですので，憶えておいてください。

sub macro2()
dim target as range
dim h as range

'見えてるセルを取得する。「全部隠れていた」場合も考える。
on error resume next
set target = worksheets("リストのシート").range("E2:E5").specialcells(xlcelltypevisible)
if target is nothing then exit sub

’以下同じ
for each h in target
on error goto errhandle
worksheets(h.value).select
on error goto 0
next
exit sub

errhandle:
’少し検査を厳しくしてみた例
if h <> "" then
worksheets("ひながたシート").copy after:=worksheets(worksheets.count)
activesheet.name = h.value
end if
resume
end sub

お礼

ご回答ありがとうございます。

そして、お手数、ご迷惑をおかけしまして申し訳ありませんでした。
以後、気を付けたいと思います。

そして、ご回答大変参考になりました！
ありがとうございました！

回答No.5

tom04

No.2です。
別質問で
＞E1～E3000などの広範囲のセル範囲の場合も
＞可能でしょうか・・・？

に関しては、前回のコード内の
＞For i = 1 To 5
の行を変更すれば可能です。
例えば
＞For i = 1 To 3000
または
＞For i = 1 To ws.Cells(Rows.Count,5).End(xlUp).Row
といった感じで！
※　ただし、上限Sheet数はメモリーに依存するみたいなので、あまりにSheet数が多すぎるとエラーになったり、PCが固まったりすると思います。

次に
＞もし、追加ではなく、あるシートをコピーして追加の場合・・・
に関しては

Sub test2()
Worksheets("Sheet名").Cells.Copy
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Paste
End Sub

とした方が良いと思います。

最後に
＞用意されたデータ範囲が非表示になってた場合
とは最初のE1以降のセルが非表示になっていた場合、非表示セルは含まない！と解釈すれば良いのですかね？

もしそうであれば前回のコード内の
＞ If WorksheetFunction.CountIf(Range(ws.Cells(1, 5), ws.Cells(i, 5)), ws.Cells(i, 5)) = 1 Then
部分を
＞If WorksheetFunction.CountIf(Range(ws.Cells(1, 5), ws.Cells(i, 5)), ws.Cells(i, 5)) = 1 _
And ws.Rows(i).Hidden = False Then

のように変更してみてください。

この程度でよろしいでしょうか？m(_ _)m

お礼

回答へのお礼にも関わらず、質問し
それに対して、お答えくださって、本当にありがとうございます。

また、こちらの回答も大変参考になりました！
今後の糧とさせていただきます。
ありがとうございました！

回答No.3

imogasi

繰り返しを「あいううう」の列のセルを主体に考えれば仕舞いで、質問になるのはなぜ。
この列をソートしておいて、上から順次見ていって、直前上行と同じ値なら、処理せず次の行に行く。
違う場合はそのセルの値でシートを追加
ーー
Sheet1のA列（シート名群）でソート済みとする。
Sub test01()
Dim sh1
Set sh1 = Worksheets("Sheet1")
d = sh1.Range("A65536").End(xlUp).Row
m = ""
For i = 2 To d
If sh1.Cells(i, "A") = m Then '上と同じ文字列なら
Else
Worksheets.Add(After:=Worksheets(Sheets.Count)).Name = sh1.Cells(i, "A") 'こういう書き方が出来た
m = sh1.Cells(i, "A")
End If
Next i
End Sub
ーー
A2:A６
aa
bb
cc
cc
dd
で、aa、ｂｂ、ｃｃ、ｄｄのシートが加わった。
ーー
シート名をソートすることがダメな場合は、現在行までの行で、同じ文字列のカウントをして２以上ならダブリとして
処理を飛ばすロジックにするとか。

お礼

ご回答ありがとうございます。

参考にさせて頂きました！！
今後ともよろしくお願いいたします。

回答No.2

tom04

こんばんは！

当然のことながら同じBook内に同名のSheetは追加できませんので、E1～E5セルには現在あるSheet名以外の文字列だとします。

↓のコードを標準モジュールにコピー＆ペーストしてマクロを実行してみてください。
尚、Sheet1のE1～E5セルに入っているとしての一例です。

Sub test()
Dim i As Long
Dim ws As Worksheet
Set ws = Worksheets("sheet1")
For i = 1 To 5
If WorksheetFunction.CountIf(Range(ws.Cells(1, 5), ws.Cells(i, 5)), ws.Cells(i, 5)) = 1 Then
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = ws.Cells(i, 5)
End If
Next i
End Sub

こんな感じではどうでしょうか？m(_ _)m

お礼

ありがとうございます。
E1～E3000などの広範囲のセル範囲の場合も
可能でしょうか・・・？
また、
もし、追加ではなく、あるシートをコピーして追加の場合
と、用意されたデータ範囲が非表示になってた場合
例えばフィルタなので隠れてたり、する場合は
含まないというやり方は、どうすればよいのでしょうか？

回答No.1

keithin

ふつーに「やるべきこと」を考えてみると
０．用意されたデータ範囲（「あいうううう」どこからどこまで何がある）の確認
１．かぶってない「あ」「い」「う」のリストを準備
２．準備したリストに従いシートの追加と名前の変更
という段取りで，淡々とマクロを書けばよいだけのお話です。

とってもムズカシそうないかにもマクロマクロしたマクロも書けますし，ごく簡単でシンプルな方法も，アイデア次第でいくらでもあります。

でもまぁ，ゴタクはいらないでしょうから作成例：
sub macro1()
　dim h as range
　for each h in worksheets("元のリストのシート名").range("E1:E" & worksheets("元のリストのシート名").range("E65536").end(xlup).row)

　on error goto errhandle
　worksheets(h.value).select
　on error goto 0
　next
exit sub

errhandle:
　worksheets.add after:=worksheets(worksheets.count)
　activesheet.name = h.value
　resume
end sub

お礼

ありがとうございます。
もし、追加ではなく、あるシートをコピーして追加の場合

worksheets.add after:=worksheets(worksheets.count)
の部分を
Worksheets("コピーしたいシート名").Copy after:=Worksheets(Worksheets.Count)

にすればいいのですよね…？

それと、用意されたデータ範囲が非表示になってた場合
例えばフィルタなので隠れてたり、する場合は
含まないというやり方は、どうすればよいのでしょうか？