|    | 
     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のあとにつけると終わると思います。 
(貼付後にいれてみました。) 
 
 | 
     
    
   |