for/if条件付きでVBA while-looping

Question

このマクロを使用して、Excelシートからrelabant情報を新しいものに抽出しています。しかし、私はそれが動作するように見えることができないと私を狂っている。

エラーを見つけたり、より良い評価を得ることができますか？

EDIT：シートの列Cのデータをソートしたい場合、それがグループ（フルーツ/ベリー）に一致させたいと思うなら、

：セルの値のようなものと一致した場合I、R）と

Private Sub Extract_Click() 

Dim ws1, ws2 As Worksheet 
Dim i,k as Integer 

set ws1 = Workbook.Activesheet 

Set ws2 = Worksheets.Add(After:= _ 
     Worksheets(ThisWorkbook.Sheets.Count)) 
ws2.Name = "Extract" & ThisWorkbook.Sheets.Count 

With ws1 

i = 10 
k = 2 

    Do While Not Range("C" & i).Value = "" 

      If Range("C" & i).Value = "Strawberry" Then 

       ws1.Range("C" & i).Copy 
       ws2.Range("A" & k).PasteSpecial Paste:=xlPasteValues 

       ws2.Range("B" & k).Value = "Berry" 

       ws1.Range("P" & i).Copy 
       ws2.Range("C" & k).PasteSpecial Paste:=xlPasteValues 

       ws1.Range("I" & i).Copy 
       ws2.Range("D" & k).PasteSpecial Paste:=xlPasteValues 

       ws1.Range("R" & i).Copy 
       ws2.Range("E" & k).PasteSpecial Paste:=xlPasteValues 

      ElseIf Range("C" & i).Value = "banana" Then 

       ws1.Range("C" & i).Copy 
       ws2.Range("A" & k).PasteSpecial Paste:=xlPasteValues 

       ws2.Range("B" & k).Value = "Fruit" 

       ws1.Range("P" & i).Copy 
       ws2.Range("C" & k).PasteSpecial Paste:=xlPasteValues 

       ws1.Range("I" & i).Copy 
       ws2.Range("D" & k).PasteSpecial Paste:=xlPasteValues 

       ws1.Range("R" & i).Copy 
       ws2.Range("E" & k).PasteSpecial Paste:=xlPasteValues 

      End If 

     k = k+1 
    i = i +1 

Loop 

End With 


End Sub 

Answer 1

をこの全体のextraxtを取ると、新しいシート（WS2に追加）

私はすべての For Loop最初を使用して、チェックをお勧めします

For i = 2 to lastRow 
If Cell(i, columnNumber).value = Cell(i, columnNumber).Value Then 
    //Do Something