register313

¦^´_ 3# marklos

Sheet1 A : J Ä檺²Ä¤@¦C­n¥ý¥[¤W¸ê®ÆªºÄæ¦ì¦WºÙ

1. Sub EX()
   
2. Sheet3.Cells.Clear
   
3. Sheet1.UsedRange.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheet3.Range("A1"), Unique:=True
   
4. With Sheet3
   
5.   For R = .[D2].End(xlDown).Row To 2 Step -1
   
6.     If .Cells(R, "D") <> "" Then
   
7.       .Rows(R + 1).EntireRow.Insert
   
8.       .Cells(R + 1, "B").Resize(1, 9).Value = .Cells(R, "B").Resize(1, 9).Value
   
9.       .Cells(R + 1, "C") = .Cells(R, "D")
   
10.     End If
    
11.   Next R
    
12.   .[D2:D65536] = ""
    
13. End With
    
14. End Sub

½Æ»s¥N½X

register313

¦^´_ 6# marklos

1. Sub EX()
   
2. Sheet3.Cells.Clear
   
3. X = 1
   
4. With Sheet2
   
5.   For R = 1 To .[A65536].End(xlUp).Row
   
6.     .Range("A" & R & ":J" & R).Copy Sheet3.Range("A" & X)
   
7.     X = X + 1
   
8.     If .Range("D" & R) <> "" Then
   
9.        .Range("A" & R & ":J" & R).Copy Sheet3.Range("A" & X)
   
10.        Sheet3.Range("D" & X - 1).Copy Sheet3.Range("C" & X)
    
11.        X = X + 1
    
12.     End If
    
13.   Next R
    
14. End With
    
15. Sheet3.[D2:D65536] = ""
    
16. End Sub

½Æ»s¥N½X