Zrobiłem trochę inaczej tzn. bez drugiego arkusza, z nadpisywaniem starych wartości i tym błędem do obróbki (błąd dodawany jest do ostatniej pozycji w rozbiciu aby pieniążki się zgadzały co do joty ;) ) Pliczek w załączniku do obejrzenia. Sub rozbij() Const dni = 365 For Each kom In Range("D1:D100") 'petla ktora rozwija wartość jeśli 'x' stoi w kol.D, mozna wywalic jesli niepotrzebne If kom.Text = "x" Then Set zakres = Range(kom.Offset(0, -3), kom.Offset(0, -1)) 'sprawdzenie czy zakres dat to wielokrotnosc dni podanych w zmiennej dni- domyslnie 365 - dzielenie latami If (zakres(2) - zakres(1)) Mod dni = 0 Then okres = Round((zakres(2) - zakres(1)) / dni, 0) If okres > 1 Then Range(zakres(2, 1), zakres(okres, 1)).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 'zrobienie miejsca dla rozbijanych wartosci wartosc = zakres(3) 'stara wartosc wrzucona jest do zmiennej wartosc, przyda sie do bledu, po nadpisaniu Range(zakres(1, 1), zakres(okres, 1)).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Step:=dni, Trend:=False Range(zakres(1, 2), zakres(okres, 2)).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Step:=-dni, Trend:=False Range(zakres(1, 2), zakres(okres, 2)).Sort zakres(2), xlAscending Range(zakres(1, 3), zakres(okres, 3)).Value = Round(wartosc / okres, 2) blad = wartosc - WorksheetFunction.Sum(Range(zakres(1, 3), zakres(okres, 3))) zakres(okres, 3).Value = Round(zakres(okres, 3).Value + blad, 2) 'dodanie bledu End If Else zakres(1, okres).EntireRow.Select MsgBox "Wybranego zakresu dat nie można podzielić na równe okresy" + Str(dni) + "-dniowe.", 16 End End If End If Next kom End Sub