[[20250409002659]]　『ユーザーフォームから新規シート（原本）を作る』（よし）　ページの最後に飛ぶ

『ユーザーフォームから新規シート（原本）を作る』（よし）

エクセル初心者です。ユーザーフォームにテキストボックスを作りました。そのテキストボックスへ文字列を入力しCommandButton1をクリックすれば、元々ある原本シートをコピー作成し、その作成されたシート名を入力した文字列にしたいのですが、テキストボックスのコピーからうまくいきません。どなたかご教示ください。
Private Sub CommandButton1_Click()

With TextBox1
.SelStart = 0
.SelLength = .TextLength
.Copy
End With

？？？？

End Sub

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

Me.TextBox1.Value
でテキストボックスの内容を取得できますが、それではダメなのでしょうか？
（OK） 2025/04/09(水) 00:51:55

CommandButton1をクリックしテキストボックスの内容は取得できたのですが、その後の別シート（原本）をコピペしてシート名をテキストボックスの文字列のするとういうことがうまくいきません🙇
（よし） 2025/04/09(水) 01:16:44

1度シート名を変える操作をマクロ記録してみては・・・
不具合があった場合それもみつかると思います
（普通） 2025/04/09(水) 07:07:48

同じお名前のシートがあれば。。。どぉするのでせうか。。。^^;
１．なにもしない
２．前のは削除♪
３．同名で番号割り付け
等々

m(__)m
（隠居Z） 2025/04/09(水) 07:42:48

同一シート名は作成できるんでしょうか。
（A） 2025/04/09(水) 09:31:06

あ。。。もちろんエラーで作れないと思いますです
で
同名　＆　重複しない番号番号割り振り
という
意味です。解りづらくて、相済みません。m(__)m
（隠居Z） 2025/04/09(水) 10:03:45

了解しました。
（A） 2025/04/09(水) 10:05:57

マクロコード省略せずに全て提示された方がより良い回答があると思います。

（?） 2025/04/09(水) 16:51:51

仕事上夜分になりすいません。
下記のようなコードで原本そのものをコピーし、末尾に新規シートを作り
ユーザーフォームのテキストをコピーしA1セルと同じ文字列をシートの
名前にしたいです。　重複しなければ問題なく作成できますが、重複した
場合はデバックとなります。重複した場合はメッセージをいれて、再度入
力させたいのですが、ご教示お願いします。

Private Sub CommandButton1_Click()

 ' コピー元のシートを指定
    Set wsCopy = ThisWorkbook.Sheets("原本")
    Set wb = ThisWorkbook

    ' シートを末尾にコピー
    wsCopy.Copy After:=wb.Sheets(wb.Sheets.Count)
 ' ユーザーフォームのテキストをコピーして貼り付け
With TextBox1
.SelStart = 0
.SelLength = .TextLength
.Copy
End With

Range("A1").Select
ActiveSheet.Paste

'シート名を変更
ActiveSheet.Name = ActiveSheet.Range("A1")

'ユーザーフォーム消す
UserForm1.Hide

（よし） 2025/04/09(水) 21:45:50

＞ユーザーフォームのテキストをコピーしA1セルと同じ文字列をシートの
名前にしたいです。
どういうことですか。
テキストをコピーしたものは何処にいったのでしょうか。
A1セルと同じ文字列をシート名にするならTextBox1はいらないでしょう。
Range("A1").Value=TextBox1.Valueだったら分かりますけど。

（?） 2025/04/09(水) 22:17:13

 ＞ ユーザーフォームのテキストをコピーしA1セルと同じ文字列をシートの
 ＞ 名前にしたいです。

 テキストボックスの値をわざわざコピーしなくても、 TextBox1.Value で文字列を取得できるので、
 それをシートの Nameプロパティに代入すればいいでしょう。

 ＞ 重複しなければ問題なく作成できますが、重複した
 ＞ 場合はデバックとなります。重複した場合はメッセージをいれて、再度入
 ＞ 力させたいのですが、ご教示お願いします。

 デバッグ(エラー)になるのは重複した場合だけではないです。
 シート名に使用できない文字が含まれていてもエラーになります。
 このようなエラーに対応するにはエラー処理を追加することになります。

 Office TANAKA - Excel VBA Tips[エラーに負けない] 
http://officetanaka.net/excel/vba/tips/tips104.htm

 ということで上記を考慮したコード例

 Sub CommandButton1_Click()

 ' コピー元のシートを指定
    Dim wsCopy As Worksheet
    Set wsCopy = ThisWorkbook.Sheets("原本")

    On Error GoTo myError

    wsCopy.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) 'シートを末尾にコピー
    With ActiveSheet 'コピーしたシート
        .Name = Me.TextBox1.Value 'シート名を変更
        .Range("A1").Value = .Name 'シート名をA1セルに
    End With

    'ユーザーフォームを非表示
    Me.Hide

    Exit Sub
 myError:
    'エラー処理
    'いろいろなエラーがあるので既定のエラーメッセージを表示させる
    MsgBox Err.Description, vbExclamation
    '再入力を即すためにテキストボックスにフォーカス移動
    Me.TextBox1.SetFocus
 End Sub

（hatena） 2025/04/10(木) 00:06:14

ありがとうございます。初心者の私に丁寧に回答してくれて恐縮ですが、
一つだけ上手くいかないところがあります。最初にコピーを促した原本
は途中でエラーが出て再入力のメッセージに移行しても、原本２という
形でシートが作成されてしまいます。エラーがでた場合はこの原本コピ
ーも無効にしたいのですが、ご教授お願いします。

（よし） 2025/04/10(木) 10:33:22

 こんな感じで

 Private Sub CommandButton1_Click()
    Dim s$, x
    s = Me.TextBox1
    If s = "" Then MsgBox "入力がありません", vbCritical: Me.TextBox1.SetFocus: Exit Sub
    If Evaluate("isref('" & s & "'!a1)") Then
        MsgBox s & " は既に存在します", vbCritical: Me.TextBox1.SetFocus: Exit Sub
    Else
        Sheets("原本").Copy , Sheets(Sheets.Count)
        With Sheets(Sheets.Count)
            .Name = s
            .[a1] = s
        End With
    End If
End Sub
（jindon） 2025/04/10(木) 11:16:32

 ＞ 最初にコピーを促した原本
 ＞ は途中でエラーが出て再入力のメッセージに移行しても、原本２という
 ＞ 形でシートが作成されてしまいます。

 あー、そうなりますね。
 事前にシート名の重複をチェックしてからコピーするように修正しました。

 シート名が適切でない場合はコピー後にシート削除するようにしました。

 Private Sub CommandButton1_Click()

    If Me.TextBox1.Value = "" Then
        MsgBox "シート名を入力してください。", vbExclamation
        Me.TextBox1.SetFocus
        Exit Sub
    End If

    On Error Resume Next
        Dim wsNew As Worksheet
        Set wsNew = Worksheets(Me.TextBox1.Value)
    On Error GoTo 0
    If Not wsNew Is Nothing Then
        MsgBox "シート名が重複しています。重複しないシート名を入力してください。", vbExclamation
        Me.TextBox1.SetFocus
        Exit Sub
    End If

 ' コピー元のシートを指定
    Dim wsCopy As Worksheet
    Set wsCopy = ThisWorkbook.Sheets("原本")

    wsCopy.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) 'シートを末尾にコピー

    On Error GoTo myError
    With ActiveSheet 'コピーしたシート
        .Name = Me.TextBox1.Value 'シート名を変更
        .Range("A1").Value = .Name 'シート名をA1セルに
    End With

    'ユーザーフォームを非表示
    Me.Hide

    Exit Sub
myError:
    'エラー処理
    MsgBox Err.Description, vbExclamation
    ActiveSheet.Delete
    '再入力を即すためにテキストボックスにフォーカス移動
    Me.TextBox1.SetFocus
 End Sub

（hatena） 2025/04/10(木) 11:44:13

 シート名に有効な文字列かも判定

 Private Sub CommandButton1_Click()
    Dim s$, e, msg$
    s = Me.TextBox1
    If s = "" Then msg = "入力がありません"
    If Len(s) > 31 Then msg = "文字数制限(31)を超えています。"
    For Each e In Array(":\?/", "[", "]", "*")
        If s Like "*[" & e & "]*" Then msg = ": \ / [ ] ? * は使用できません。": Exit For
    Next
    If Len(msg) Then MsgBox msg: Me.TextBox1.SetFocus: Exit Sub
    If Evaluate("isref('" & s & "'!a1)") Then
        MsgBox s & " は既に存在します", vbCritical: Me.TextBox1.SetFocus
    Else
        Sheets("原本").Copy , Sheets(Sheets.Count)
        With Sheets(Sheets.Count)
            .Name = s
            .[a1] = s
        End With
    End If
End Sub
（jindon） 2025/04/10(木) 12:04:29

できました。
ありがとうございました。
エクセル初心者の私に丁寧に教えていただき、勉強になりました。
（よし） 2025/04/10(木) 17:45:45

コメント返信：

[ 一覧(最新更新順) ]

[[20250409002659]] 『ユーザーフォームから新規シート（原本）を作る』（よし） ページの最後に飛ぶ

[[20250409002659]]　『ユーザーフォームから新規シート（原本）を作る』（よし）　ページの最後に飛ぶ