エクセルVBAでデータをカウントしたい 【コード訂正願い】

マクロ初心者です。
先ほどと似たような質問となり大変恐縮なのですが、
以下の内容についてマクロを組みたいと考えています。

Sheet1 に以下の様なデータが入力されております。
A列　　　　　B列　　　　C列　　　　　　　D列
（品名）　（種類） 　（産地）　　　　　　（個数）
りんご　　　　赤　　　　　　　　　　　　　　90
バナナ　　　　　　　　　台湾産　　　　　　　15
りんご　　　　青　　　　　　　　　　　　　　10
りんご　　　　赤　　　　　　　　　　　　　　20
りんご　　　　青　　　　　　　　　　　　　　20
バナナ　　　　　　　　　国産　　　　　　　　20
バナナ　　　　　　　　　国産　　　　　　　　25　

Sheet2 に自動的に以下の様に集計させたいのです。
A列　　　　　B列　　　　C列　　　　　　　　D列
（品名）　（種類） 　（産地）　　　　　　　（個数）
りんご　　　　赤　　　　　　　　　　　　　　110
りんご　　　　青　　　　　　　　　　　　　　30
バナナ　　　　　　　　　台湾産　　　　　　　15
バナナ　　　　　　　　　国産　　　　　　　　45


このように、代表を表示させ、それに対応する個数の合計を
表示させたいのですが、どのように作成すればよろしいでしょうか。


できればコードを示して頂けますと非常に助かります。
ご教授のほど宜しくお願い致します。

sort key を複数設定すると思われるのですが、何卒よろしく
お願い致します。

＞
Sub 転記()
Dim i As Long, lastRow As Long, wS As Worksheet
Set wS = Worksheets("Sheet2")
wS.Rows("2:" & Rows.Count).Clear
With Worksheets("Sheet1")
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
.Range("D:D").Insert
.Range("D1") = "ダミー"
Range(.Cells(2, "D"), .Cells(lastRow, "D")).Formula = "=A2&""_""&B2"
.Range("D:D").AdvancedFilter Action:=xlFilterCopy, copytorange:=wS.Range("A1"), unique:=True
wS.Range("A:A").Sort key1:=wS.Range("A1"), order1:=xlAscending, Header:=xlYes
.Range("A1").Resize(, 3).Copy wS.Range("A1")
lastRow = wS.Cells(Rows.Count, "A").End(xlUp).Row
With Range(wS.Cells(2, "C"), wS.Cells(lastRow, "C"))
.Formula = "=SUMIF(Sheet1!D:D,A2,Sheet1!C:C) "
.Value = .Value
End With
Application.DisplayAlerts = False
wS.Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
Tab:=True, OtherChar:="_", FieldInfo:=Array(Array(1, 1), Array(2, 1))
Application.DisplayAlerts = True
.Range("A1").Resize(, 3).Copy wS.Range("A1")
.Range("D:D").Delete
End With

End Sub

以上

No.1 ベストアンサー 回答者： GooUserラック 回答日時： 2016/05/09 22:56

こんなのはいかがですか？

Sub 転記Macro()

Dim 元行 As Long
Dim 先行 As Long
Dim 小計 As Long
Dim 一致 As Boolean

Sheets("Sheet2").Select
Cells.ClearContents
Sheets("Sheet1").Select
Cells.Sort _
Key1:=Range("A2"), Order1:=xlAscending, _
Key2:=Range("B2"), Order2:=xlAscending, _
Key3:=Range("C2"), Order3:=xlAscending, _
Header:=xlYes, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin
元行 = 2
Do While Cells(元行 - 1, 1).Value <> ""
一致 = False
If Cells(元行, 1).Value = Cells(元行 - 1, 1).Value Then
If Cells(元行, 2).Value = Cells(元行 - 1, 2).Value Then
If Cells(元行, 3).Value = Cells(元行 - 1, 3).Value Then
一致 = True
End If
End If
End If
If 一致 Then
小計 = 小計 + Cells(元行, 4).Value
Else
先行 = 先行 + 1
Sheets("Sheet2").Cells(先行, 1).Value = Cells(元行 - 1, 1).Value
Sheets("Sheet2").Cells(先行, 2).Value = Cells(元行 - 1, 2).Value
Sheets("Sheet2").Cells(先行, 3).Value = Cells(元行 - 1, 3).Value
Sheets("Sheet2").Cells(先行, 4).Value = 小計
小計 = Cells(元行, 4).Value
End If
元行 = 元行 + 1
Loop
Sheets("Sheet2").Select
Cells(1, 4).Value = "小計"

End Sub