【EXCEL】Alt＋F8からマクロを呼び出す時とユーザーフォームの違いについて

Question

閉じたワークブック(1個)からワークシートをコピーして、
アクティブのワークブックに挿入するマクロを作成しました。

普通に、Alt＋F8からマクロを呼び出す時は問題なかったのですが、
ユーザーフォームのボタンに貼り付けて、
呼び出すとエラーになって機能しませんでした。

いろいろ試してみて、以下のところまで出来たのですが
どこが間違っているのかわかりません。

すいませんがユーザーフォームの機能に詳しい方
説明の上手な方、コードで直接説明出来る方、
以下のコードの間違いを教えて下さい。

--------------------
機能の詳細
「CommandButton25」からボタン一発で
所定のワークブックの(1)、特定のシート(2)をコピーして
アクティブのワークブックに挿入する
※マクロはアクティブのワークブックの中にある

1-A）取り込み先の閉じたワークブックの場所
"C:\A"(Cドライブの「A」フォルダー)

1-B）取り込み先の閉じたワークブックの名前
「取込み先.xls」

2)コピーしてくるシートの名前
「TextBox1」の中に記載された文字列を読み取る
--------------------

追記
１）
エラーメッセージの詳細は画像をご参照ください

２）
作成したマクロは以前、こちらのサイトで頂いた
よく似た機能のマクロをカスタマイズしたものです。
※機能が少し違うので余計なコードが残っているかもしれません。
↓
【VBA】3個のワークブックから同時にシートをコピーしたい
https://oshiete.goo.ne.jp/qa/9476111.html


--------------------

Private Sub CommandButton25_Click()
Const dirname As String = "C:\A"
 '1つのワークブックからシートを1つコピーする
 
Public Sub CopySheets()
 Dim dirname As String
 Dim trgbooks As Variant
 Dim trgsheets As Variant
 Dim i As Long
 Dim j As Variant
 j = TextBox1.Value
  
 trgbooks = Array("取込み先.xls")
 trgsheets = Array(j)
For i = 0 To UBound(trgbooks)
 'sheetの取り込み
Call GetSheet(trgbooks(i), trgsheets(i))
 Next
 End Sub
 
 '指定ブックの指定シートを取り込む
Public Sub GetSheet(ByVal bookName As String, ByVal SheetName As String)
 Dim fullName As String
 Dim myBook As String
 Dim mySheet As String
 myBook = ThisWorkbook.Name
 mySheet = Worksheets(1).Name
 If ExistsWorkSheet(SheetName) Then
 Application.DisplayAlerts = False 'シート削除時の警告を出さないようにする
Worksheets(SheetName).Delete '既に該当シートがあるなら削除する
Application.DisplayAlerts = True 'シート削除時の警告を出すようにする（元に戻す）
End If
 fullName = dirname & "\" & bookName
 If Dir(fullName) = "" Then
 MsgBox (fullName & "は存在しません")
Exit Sub
End If

 Workbooks.Open fullName
 Workbooks(bookName).Activate
 If ExistsWorkSheet(SheetName) = False Then
 MsgBox (bookName & "中に" & SheetName & "は存在しません")
Workbooks(bookName).Close
 Exit Sub
 End If

 Worksheets(SheetName).Copy after:=Workbooks(myBook).Worksheets(mySheet)
 Application.DisplayAlerts = False 'セーブのメッセージ出さない
 Workbooks(bookName).Close
  Workbooks(myBook).Activate
  MsgBox (bookName & "中の" & SheetName & "をコピー完了")
  Sheets("　番　号　確　認　").Select
'動作確認にA1セルに移動
 Range("A1").Select
  End Sub
 
 'ワークシートの存在チェック
Public Function ExistsWorkSheet(ByVal SheetName As String) As Boolean
 Dim ws As Worksheet
 ExistsWorkSheet = False
 For Each ws In Worksheets
 If ws.Name = SheetName Then
 ExistsWorkSheet = True
 Exit Function
 End If
 Next ws
 End Sub

tatsu99 · Accepted Answer

以下のようにしてください。（いろいろ修正しました）
不明点は補足してください。
-------------------------------------------------------
Private Sub CommandButton25_Click()
    '1つのワークブックからシートを1つコピーする
    If TextBox1.Value = "" Then
        MsgBox ("TextBox1にシート名なし")
        Exit Sub
    End If
    'sheetの取り込み
    Call GetSheet("取込み先.xls", TextBox1.Value)
End Sub

'指定ブックの指定シートを取り込む
Public Sub GetSheet(ByVal bookName As String, ByVal SheetName As String)
    Const dirname As String = "C:\A"
    'Const dirname As String = "d:\goo\excel\goo33"
    Dim fullName As String
   
    fullName = dirname & "\" & bookName
    If Dir(fullName) = "" Then
        MsgBox (fullName & "は存在しません")
        Exit Sub
    End If
    
    Workbooks.Open fullName
    Workbooks(bookName).Activate
    If ExistsWorkSheet(SheetName) = False Then
        MsgBox (bookName & "中に" & SheetName & "は存在しません")
        Workbooks(bookName).Close
        Exit Sub
    End If
    'マクロのあるBookをActivateする
    ThisWorkbook.Activate
    If ExistsWorkSheet(SheetName) Then
        Application.DisplayAlerts = False 'シート削除時の警告を出さないようにする
        Worksheets(SheetName).Delete '既に該当シートがあるなら削除する
        Application.DisplayAlerts = True 'シート削除時の警告を出すようにする（元に戻す）
    End If
    
    Workbooks(bookName).Worksheets(SheetName).Copy after:=Worksheets(Worksheets.Count)
    Workbooks(bookName).Close
    MsgBox (bookName & "中の" & SheetName & "をコピー完了")
    Sheets("　番　号　確　認　").Select
    '動作確認にA1セルに移動
    Range("A1").Select
End Sub

'ワークシートの存在チェック
Public Function ExistsWorkSheet(ByVal SheetName As String) As Boolean
    Dim ws As Worksheet
    ExistsWorkSheet = False
    For Each ws In Worksheets
        If UCase(ws.Name) = UCase(SheetName) Then
            ExistsWorkSheet = True
            Exit Function
        End If
    Next ws
End Function
----------------------------

【EXCEL】Alt＋F8からマクロを呼び出す時とユーザーフォームの違いについて

以下のようにしてください。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング