| 
    
     |  | Option Explicit 
 For Each BUHIN In Range("D5:D37")
 If BUHIN = KAIRO1 Then
 BUHIN.Activate
 Arow = ActiveCell.Row
 With Worksheets(1).Range("E" & Arow)
 Set SUMI = .Find(SUMI1, LookIn:=xlValues)
 If Not SUMI Is Nothing Then
 Workbooks("データ入力macro.xls").Sheets("実施").Range("D21:E21").Copy
 Windows(FILE & ".xls").Activate
 Worksheets(1).Select
 Range("P" & Arow).Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
 End If
 End With
 >  Exit For
 Else
 BUHIN.Activate
 End If
 Next BUHIN
 
 End Withのあとにつけると終わると思います。
 (貼付後にいれてみました。)
 
 |  |