Hsieh

¦^´_ 1# jcchiang

1.     Sub ex()
   
2. Dim Rng As Range
   
3. With Sheet2
   
4.   r = 2
   
5.   Do Until .Cells(r, 1) = ""
   
6.   a = .Cells(r, 1)
   
7.   With Sheet1
   
8.      Set c = .Columns("A").Find(a, lookat:=xlWhole)
   
9.      If Not c Is Nothing Then
   
10.      Set c = c.MergeArea.Resize(, 6)
    
11.         If Rng Is Nothing Then
    
12.            Set Rng = c
    
13.         Else
    
14.            Set Rng = Union(Rng, c)
    
15.         End If
    
16.      End If
    
17.   End With
    
18.   r = r + 1
    
19.   Loop
    
20. End With
    
21. With Sheet3
    
22.   .UsedRange.Offset(1).Clear
    
23.   Rng.Copy .[A2]
    
24. End With
    
25. End Sub

½Æ»s¥N½X