lol I was been silly
use this code
Option Explicit
Sub SplitVouchers()
Dim lRowtoCopy As Long
Dim lHowManyCopies As Long
Dim dblTotal As Double
Dim r As Range
' Determine the row to copy and the amount of copies.
lRowtoCopy = Val(InputBox("Row Number of Voucher to Copy", Title:="Voucher Payments"))
lHowManyCopies = Val(InputBox("How many Payments within this Voucher?", "Voucher Payments"))
If Not lRowtoCopy < 1 And Not lHowManyCopies < 1 Then
' Copy the rows.
Rows(lRowtoCopy).Copy
Rows(lRowtoCopy).Resize(lHowManyCopies - 1).EntireRow.Insert
Application.CutCopyMode = False
' Distribute the amounts.
dblTotal = Range("G" & lRowtoCopy).Value
For Each r In Range("G" & lRowtoCopy).Resize(lHowManyCopies)
r.Value = InputBox("Enter value for " & r.Address, "Split Voucher Payments")
Next r
' Check the totals
If Not CStr(Application.Sum(Range("G" & lRowtoCopy).Resize(lHowManyCopies))) = CStr(dblTotal) Then
Range("G" & lRowtoCopy).Value = dblTotal
Range("G" & lRowtoCopy).Offset(1).Resize(lHowManyCopies - 1).Value = 0
MsgBox "Your totals do not match. The total has been allocated to the original voucher."
End If
End If
End Sub
Thanks