紧急求助！！！感谢好心人！！！

likun17

xiangbaoan 发表于 2018-10-6 08:00
………………

感谢 感谢 感谢

hdbk

Sub copyaa()
Dim i%, o%, p%
For o = 2 To [E1000].End(xlUp).Row
p = p + Application.Sum(Cells(o, 5))
Next
For i = 2 To (p + o)
     k = Cells(i, 5)
          If Cells(i, 1) <> "" And k > 1 Then
          Rows(i + 1).Resize(k - 1, 1).Insert (3)
          End If
Next
arr = Sheets("sheet1").UsedRange
For j = 2 To UBound(arr)
    For k = 1 To UBound(arr, 2)
        If arr(j, k) = "" Then
        arr(j, k) = arr(j - 1, k)
        End If
     Next
Next
Sheets("sheet1").Range("a1").Resize(UBound(arr), 6) = arr
End Sub