| 
    
     |  | 有難う御座います。早速やってみます。 
 あと今回までにご相談しました下記コードの中で
 InPtに入力された値をC3セルに入れ、VLOOKUP関数を使って表示し、
 表示された内容を新規ブックにコピーしていましたが
 VLOOKUP関数の表記が長すぎて、入力できずに困ってます。
 これもVBAコードに入れ込みたいのですが、どうすれば
 よろしいでしょうか。
 
 ・セルに入力したVLOOKUP関数
 =IF($C$3="","",TRIM(CONCATENATE(VLOOKUP($C$3,台帳!$C$5:$CP$3000,24,FALSE),
 VLOOKUP($C$3,台帳!$C$5:$CP$3000,25,FALSE),VLOOKUP($C$3,台帳!$C$5:$CP$3000,26,FALSE),
 VLOOKUP($C$3,台帳!$C$5:$CP$3000,27,FALSE),VLOOKUP($C$3,台帳!$C$5:$CP$3000,28,FALSE),
 VLOOKUP($C$3,台帳!$C$5:$CP$3000,29,FALSE),VLOOKUP($C$3,台帳!$C$5:$CP$3000,30,FALSE),
 VLOOKUP($C$3,台帳!$C$5:$CP$3000,31,FALSE),VLOOKUP($C$3,台帳!$C$5:$CP$3000,32,FALSE)," ",
 VLOOKUP($C$3,台帳!$C$5:$CP$3000,33,FALSE),VLOOKUP($C$3,台帳!$C$5:$CP$3000,34,FALSE)・・・VLOOKUP($C$3,台帳!$C$5:$CP$3000,64,FALSE)
 
 ・ご相談しているVBAコード
 Private Sub タグ作成_Click()
 Dim ws As Worksheet
 Dim InPt As Long
 InPt = Application.InputBox(prompt:="No.を入力して下さい。", Type:=1)
 If InPt = False Then Exit Sub
 If ActiveSheet.Range("$c$5:$c$3000").Find(What:=InPt, _
 LookIn:=xlValues, _
 lookat:=xlWhole, _
 SearchOrder:=xlByColumns, _
 MatchByte:=False) Is Nothing Then
 MsgBox "No." & InPt & "は登録されていません。"
 Exit Sub
 End If
 Application.EnableEvents = False
 Set ws = ThisWorkbook.Sheets("タグ")
 ws.Range("C3").Value = InPt
 With Workbooks.Add
 With .Sheets(1)
 ws.Range("B2:C16").Copy
 .Range("B2").PasteSpecial Paste:=xlFormats
 .Range("B2").PasteSpecial Paste:=xlValues
 .Range("A:A,D:D").ColumnWidth = 0.5
 .Columns("B:B").ColumnWidth = 10
 .Columns("C:C").ColumnWidth = 50
 .Rows(1).RowHeight = 5
 .Rows(17).RowHeight = 5
 .Columns("E:IV").Hidden = True
 .Rows("18:65536").Hidden = True
 .Range("c3").Locked = True
 .Protect password:="1234"
 End With
 With .Windows(1)
 .DisplayGridlines = False
 .DisplayHeadings = False
 .DisplayOutline = False
 .DisplayZeros = False
 .DisplayHorizontalScrollBar = False
 .DisplayVerticalScrollBar = False
 .DisplayWorkbookTabs = False
 End With
 .SaveAs Filename:=ThisWorkbook.Path & "\" & InPt & "タグ.xls"
 .DisplayAlerts = False
 .Close False
 End With
 ws.Range("C3").ClearContents
 With Application
 .EnableEvents = True
 End With
 Set ws = Nothing
 MsgBox "タグ作成しました。"
 
 |  |