セル内に入力した文字をシート名にするマクロ

質問

セル内に入力した文字をシート名にするマクロの方法を探しています

やりたいことは以下のようなことなのですが

http://www.excel.studio-kazu.jp/kw/20021007161409.html

上記のアドレスが若干似ているんですがやりたいこととは少し違います

A1　ヤマダ

A2　こじま

A3　123456

A4　abcde

とセル内に入力されている文字を

シート名にしたいです

A1～A4まで一度に選択して選択した数だけ

この場合はA1～A4までなので四枚新しくシートを作り

新しく作ったシートにA1～A4のセル内の文字をシート名に上から順番に

A1から左寄せにしたいです

回答No.1

kybo · ベストアンサー

以下の様な感じかなと思います。

Sub macro()
Dim C As Range
For Each C In Selection
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = C.Value
Next C
End Sub

お礼

ありがとうございます
まさにやりたいことでした
本当にありがとうございました

回答No.5

okormazd

#4です。たびたびすいません。
どうも汚いコードを書いてしまって・・・。

Sub test1()
cn = 1
For Each c In Selection
Sheets.Add(Sheets(cn)).Name = CStr(c.Value)
cn = cn + 1
Next
End Sub

でいいかと。

回答No.4

okormazd

#2です。
「左寄せ」の意味が解らなかった。
ということであれば、

同じシート名がある可能性がなければ、

Sub test1()

cn = 1
For Each c In Selection
　 If cn = 1 Then
　　Sheets.Add.Name = CStr(c.Value)
　　cn = cn + 1
　Else
　　Sheets.Add(Sheets(cn)).Name = CStr(c.Value)
　　 cn = cn + 1
　End If
Next

End Sub

同じシート名がある可能性があれば、

Sub test2()

cn = 1
For Each c In Selection
　fsh = True
　For Each sh In ActiveWorkbook.Sheets
　If sh.Name = CStr(c.Value) Then
　　fsh = False
　　Exit For
　End If
　Next
　If fsh Then
　　If cn = 1 Then
　　　Sheets.Add.Name = CStr(c.Value)
　　　cn = cn + 1
　　Else
　　　Sheets.Add(Sheets(cn)).Name = CStr(c.Value)
　　　cn = cn + 1
　　End If
　　fsh = False
　End If
Next

End Sub

というようなことか。

お礼

ご丁寧に二つもコードを記述して頂きまして
ありがとうございました
困っていたので大変助かりました

回答No.3

tom04

こんにちは！
一例です。

Alt+F11キー　→　画面左の「This Workbook」をダブルクリック　→　VBE画面に
↓のコードをコピー＆ペーストしてマクロを実行してみてください。
Sheet1にデータがあるとしています。

Sub test()
Dim c As Range
Dim k As Long
For Each c In Selection
If c <> "" Then
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = c
End If
Next c
For k = Worksheets.Count To 2 Step -1
If Worksheets(k).Name Like "Sheet*" Then
Application.DisplayAlerts = False
Worksheets(k).Delete
End If
Next k
End Sub

※　複数列を範囲指定すると
（仮にA1～B3セルを範囲指定したとします）
Sheet順は
A1　→　B1　→　A2　→　B2　→　A3　→　B3
の順になります。

参考になりますかね？m(_ _)m

お礼

ありがとうございます
とっても参考になりました
素晴らしいです

回答No.2

okormazd

同じシート名がなれれば、次でできるが、

Sub　test()
For　Each　c　In　Selection
　Sheets.Add.Name　=　CStr(c.Value)
　Next
End　Sub

同じシート名があるときのエラーを避けるには、

Sub test()

For Each c In Selection
fsh = True
For Each sh In ActiveWorkbook.Sheets
If sh.Name = CStr(c.Value) Then
fsh = False
Exit For
End If
Next
If fsh Then
Sheets.Add.Name = c.Value
fsh = False
End If
Next

End Sub

とかになるか。

補足

ありがとうございます
早速やってみたのですが
1つ目も二つ目も
A1が左寄せではなく右寄せになってしまいました
やりたいことはA1が一番左、A4（一番最後のセル）が
一番右に並ぶようにしたいです