register313

¦^´_ 1# man65boy

1. Sub xx()
   
2. Dim Rng As Range, A As Range
   
3. Sheet1.[A1:E1].Copy Sheet2.[A1]
   
4. With Sheet1
   
5.   For Each A In .Range(.[A2], .[A2].End(xlDown))
   
6.     If A.Offset(0, 4) = "¦Û¨ú" Then
   
7.       If Rng Is Nothing Then
   
8.          Set Rng = A.Resize(1, 5)
   
9.       Else
   
10.          Set Rng = Union(Rng, A.Resize(1, 5))
    
11.       End If
    
12.     End If
    
13.   Next
    
14.   If Not Rng Is Nothing Then
    
15.      Rng.Copy Sheet2.[A65536].End(xlUp).Offset(1, 0)
    
16.      Rng.EntireRow.Delete
    
17.   End If
    
18. End With
    
19. End Sub

½Æ»s¥N½X