VBA: Kopier indhold af celle, men begræns antal decimaler

Dataen i celle (i+3,5) er numerisk og med et varierende antal decimaler. Jeg skal imidlertid begrænse dette til at kopiere afrunde og kopiere max tre decimaler.
Kan det indbygges i dette script er det optimalt, men hvis ikke har jeg forsøgt mig med en anden løsning i script 2:
------------------------------------------------------
Sub Loop1()
Open "C:\test.txt" For Append As #1
            Dim i As Integer
            For i = 1 To Selection.CurrentRegion.Rows.Count - 1
            'If statement
    If Not (IsError(Worksheets("Ark1").Cells(i + 3, 5))) Then
        If Worksheets("Ark1").Cells(i + 3, 7) = "" And Worksheets("Ark1").Cells(i + 3, 2) <> "" And Worksheets("Ark1").Cells(i + 3, 5) <> "" Then
            Print #1, "autECLSession.autECLOIA.WaitForAppAvailable"
            Print #1, ""
            Print #1, "autECLSession.autECLOIA.WaitForInputReady"
            Print #1, "autECLSession.autECLPS.SendKeys " & Chr(34) & Worksheets("Ark1").Cells(i + 3, 2) & "01" & Chr(34)
            Print #1, "autECLSession.autECLOIA.WaitForInputReady"
            Print #1, "autECLSession.autECLPS.SendKeys " & Chr(34) & "[Tab]" & Chr(34)
            Print #1, "autECLSession.autECLOIA.WaitForInputReady"
            Print #1, "autECLSession.autECLPS.SendKeys " & Chr(34) & Worksheets("Ark1").Cells(i + 3, 5) & Chr(34)
            Print #1, "autECLSession.autECLOIA.WaitForInputReady"
            Print #1, "autECLSession.autECLPS.SendKeys " & Chr(34) & "[pf20]" & Chr(34)
        End If
    End If
            Next i
        Print #1, ""
        Print #1, "End Sub"
        Close #1
End Sub
---------------------------------------------

Script 2 (hvor den dog kopierer alle decimalerne, men her må kunne indbygges en afrundning, så cellens værdi MAX udgør xxxx,xxx):
---------------------------------------------
    Dim i As Integer
    For i = 1 To Selection.CurrentRegion.Rows.Count - 1
        If Not (IsError(Worksheets("Ark1").Cells(i + 3, 5))) Then
            Worksheets("Ark1").Cells(i + 3, 5).copy
            Worksheets("Ark1").Cells(i + 3, 6).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            Application.CutCopyMode = False
        End If
        Next i
-----------------------------------------------------