| 
    
     |  | お世話になります。 先日はありがとうございました。
 追加でBook2のテーブルに該当しない場合は
 Book4にコピーする必要がでてきました。
 見よう見まねで以下のようにWS4関連のマクロを追加しました。
 こんな感じでよろしいのでしょうか?
 幸いにも走行は可能でしたが
 Do〜Loopの間の意味が理解できていないため
 バグが出たときに不安です・・・。
 
 Sub test()
 
 Dim WS1 As Worksheet
 Dim WS2 As Worksheet
 Dim WS3 As Worksheet
 Dim WS4 As Worksheet
 Dim r As Range, rr As Range
 Dim s As Range, ss As Range
 Dim i As Long
 
 Set WS1 = Workbooks("Book1.xls").Worksheets("Sheet1")
 Set WS2 = Workbooks("Book2.xls").Worksheets("Sheet1")
 Set WS3 = Workbooks("Book3.xls").Worksheets("Sheet1")
 Set WS4 = Workbooks("Book4.xls").Worksheets("Sheet1")
 Set rr = WS3.Range("A1")
 Set ss = WS4.Range("A1")
 
 i = 1
 With WS1
 Do
 Set r = WS2.Columns("B").Find(What:=.Range("A" & i).Value, _
 LookIn:=xlValues, LookAt:=xlWhole)
 If Not r Is Nothing Then
 rr.Resize(, 6).Value = .Range("A" & i).Resize(, 6).Value
 Set rr = rr.Offset(1)
 Else
 ss.Resize(, 6).Value = .Range("A" & i).Resize(, 6).Value
 Set ss = ss.Offset(1)
 End If
 Set r = Nothing
 i = i + 1
 Loop Until i > .Range("A" & Rows.Count).End(xlUp).Row
 End With
 End Sub
 
 |  |