关于#vba#的问题，如何解决？

运行以后能进行建立工作表并且按照部门命名工作表 但是每个工作表只有一行数据并且填入的位置也不对
Sub chaifen()
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim i As Integer
Dim sh As Worksheet

If Sheets.Count > 1 Then
For i = Worksheets.Count To 2 Step -1
Worksheets(i).Delete
Next i
End If

Dim irow As Integer
Dim istant As Integer

irow = Range("a" & Rows.Count).End(xlUp).Row
If irow > 2 Then
Range("a2:h" & irow).Sort Range("d2"), xlAscending
istart = 2
For i = 2 To irow
With Worksheets("数据")

If .Range("d" & i).Value <> .Range("d" & i + 1).Value Then

Worksheets.Add after:=Worksheets(Sheets.Count)
Set sh = Worksheets(Worksheets.Count)
sh.Name = .Range("d" & i).Value
.Range("a1:f1").Copy sh.Range("a1:f1")
.Range("a" & i & ":f" & i).Copy sh.Range("e2")

ostart = i + 1
End If
End With
Next i
End If
Worksheets("数据").slect
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub