| 
    
     |  | こんばんわ。 以前、条件移動についてご質問させて頂き
 下記のように教えて頂きました。
 下記のプログラムはsheet1のA1とsheet2のA1を比較し
 これらが同じの場合のみsheet2からsheet1コピーするようなものです。
 
 しかし、困ったことに、A1の列でしか比較ができずにいます。
 たとえば、sheet1のD10〜D30の列とsheet2のB7からB27まで
 比較し下記のような動作ができるようにしたいのですが。
 教えて頂けないでしょうか?
 
 下記は以前教えて頂いた型です。
 -----------------------------------------------------------
 
 
 Sub Try1()        'WS2 → WS1
 Dim WS1 As Worksheet
 Dim WS2 As Worksheet
 Dim r1 As Range, c As Range
 Dim r2 As Range
 Dim r22 As Range
 
 Set WS1 = Worksheets("Sheet1")
 Set WS2 = Worksheets("Sheet2")
 
 Set r1 = WS1.Range("A1", WS1.Cells(WS1.Rows.Count, 1).End(xlUp))
 Set r2 = WS2.Range("A1", WS2.Cells(WS2.Rows.Count, 1).End(xlUp))
 Set r22 = r2.Offset(, 2).Resize(, 5)
 Dim m
 r1.Offset(, 2).Resize(, 5).ClearContents
 For Each c In r1
 m = Application.Match(c, r2, 0)
 If IsNumeric(m) Then
 r22.Rows(m).Copy c(1, 2)
 End If
 Next
 
 End Sub
 
 |  |