Sub SPLIT_LIC_CLAIM()
Dim ws As Worksheet
Dim newWs As Worksheet
Dim lastRow As Long
Dim lastCol As Long
Dim i As Long
Dim j As Long
Dim newRow As Long
Dim resultRows As Long
Dim amount As Double
'Ìàññèâ èñõîäíûõ äàííûõ è ðåçóëüòàòà
Dim data As Variant
Dim result As Variant
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Set ws = ThisWorkbook.Worksheets("LIC CLAIM INPUT")
Application.DisplayAlerts = False
On Error Resume Next
ThisWorkbook.Worksheets("LIC CLAIM").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Set newWs = ThisWorkbook.Worksheets.Add(After:=ws)
newWs.Name = "LIC CLAIM"
physicalPercent = Sheets("LIC CLAIM MAIN").Range("A2").Value
legalPercent = Sheets("LIC CLAIM MAIN").Range("B2").Value
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
'Âñþ òàáëèöó â ïàìÿòü çàãðóæàåì
data = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, lastCol)).Value
Set ugDict = CreateObject
resultRows = 1
For i = 2 To lastRow
If IsNumeric(data(i, 4)) _
And data(i, 4) <> "" Then
resultRows = resultRows + 2
Else
resultRows = resultRows + 1
End If
Next i
'Ñîçäàåì ìàññèâ äëÿ ðåçóëüòàòîâ
ReDim result(1 To resultRows, 1 To lastCol)
For j = 1 To lastCol
result(1, j) = data(1, j)
Next j
newRow = 2
For i = 2 To lastRow
If IsNumeric(data(i, 4)) _
And data(i, 4) <> "" Then
amount = data(i, 4)
For j = 1 To lastCol
result(newRow, j) = data(i, j)
Next j
result(newRow, 1) = "ÎÑÀÃÎ_Ôèí"
result(newRow, 4) = amount * physicalPercent
newRow = newRow + 1
For j = 1 To lastCol
result(newRow, j) = data(i, j)
Next j
result(newRow, 1) = "ÎÑÀÃÎ_Þð"
result(newRow, 4) = amount * legalPercent
newRow = newRow + 1
Else
For j = 1 To lastCol
result(newRow, j) = data(i, j)
Next j
newRow = newRow + 1
End If
Next i
newWs.Range( _
newWs.Cells(1, 1), _
newWs.Cells(resultRows, lastCol) _
).Value = result
newWs.Columns.AutoFit
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
MsgBox "ÃÎÒÎÂÎ!"
End Sub