|
コピー側から、実行ように修正すると、うまくいきました。
大変、お騒がせしました。
Sub シートの追加()
Dim myBook As Workbook
Dim Bookname As String
Dim I As Long, j As Long
Dim Shname As String
With ThisWorkbook.Worksheets("Menu")
For j = 4 To 10 Step 3
For I = 5 To 29 Step 2
If .Cells(I, j).Value <> "" And .Cells(I, j - 1).Value <> "" Then
Shname = Trim(.Cells(I, j - 1).Value)
Exit For
End If
Next I
Next j
End With
For Each myBook In Workbooks '開かれたBookのチェック
If myBook.Name = ThisWorkbook.Name Then
Else
Bookname = myBook.Name
Exit For
End If
Next
MsgBox Workbooks(Bookname).Name
MsgBox Shname
MsgBox ThisWorkbook.Name
Workbooks(Bookname).Worksheets(Shname).Copy After:=ThisWorkbook.Sheets("Menu")
End Sub
|
|