Hallo zusammen,

ich habe DIE LÖSUNG für mein Problem gefunden !
Zumindest solang bis sich ggf. eine noch unbekannte Datenlage einstellt.

Nachfolgend ein Auszug des VBA-Codes, der meine Probleme mit den von mir getesteten Daten-Konstellationen 100%ig löst.

Sub ExportRangeToPDF()
    Dim ws As Worksheet
    Dim rng As Range
    Dim fileName As String
    Dim folderPath As String
    Dim pdfFileName As String
    Dim firstCell As Range
    Dim pos As Long
    Dim revision As String
    Dim cell As Range
    Dim countCellsWith20Chars As Long
    Dim columnOCount As Long
    Dim columnPCount As Long
    Dim newRng As Range
    Dim hwnd As Long
    Dim hwndChild As Long
    Dim windowText As String
    Dim windowTextLength As Long
    Dim explorerFound As Boolean
    Dim summeTeilsummen As Double
    Dim differenz As Double
    Dim lastCell As Range
    Dim originalFormel As String
    Dim tempSum As Double
    Dim originalFormulas As Collection
    Dim totalValue As Double

    ' Sammlung für die ursprünglichen Formeln erstellen
    Set originalFormulas = New Collection

    ' Kaufmännisch runden und die Werte in die Zellen schreiben
    For Each cell In rng.Columns(2).Cells
        If cell.HasFormula Then
            ' Ursprüngliche Formel speichern
            originalFormulas.Add cell.Formula, CStr(cell.Address)
            ' Kaufmännisch gerundeten Wert in die Zelle schreiben
            cell.Value = WorksheetFunction.Round(cell.Value, 2)
        ElseIf IsNumeric(cell.Value) Then
            ' Kaufmännisch gerundeten Wert in die Zelle schreiben
            cell.Value = WorksheetFunction.Round(cell.Value, 2)
        End If
    Next cell
    
    ' Summe der Teilsummen berechnen
    tempSum = 0
    For Each cell In rng.Columns(2).Resize(rng.Rows.Count - 1, 1).Offset(1, 0).Cells
        tempSum = tempSum + WorksheetFunction.Round(cell.Value, 2)
    Next cell
    summeTeilsummen = tempSum

    ' Gesamtwert berechnen
    Set firstCell = rng.Cells(1, 2)
    totalValue = WorksheetFunction.Round(firstCell.Value, 2)

    ' Differenz berechnen
    differenz = totalValue - summeTeilsummen

    ' Nur wenn die Differenz signifikant ist, wird die letzte Zelle angepasst
    If Abs(differenz) > 0.0001 Then ' Toleranzwert für minimale Differenzen
        ' Letzte Zelle in der rechten Spalte des markierten Bereichs festlegen
        Set lastCell = rng.Cells(rng.Rows.Count, 2)
        
        ' Ursprüngliche Formel der letzten Zelle speichern
        If lastCell.HasFormula Then
            originalFormulaLastCell = lastCell.Formula
        End If
        
        ' Differenz auf den letzten Teilbetrag addieren
        lastCell.Value = WorksheetFunction.Round(lastCell.Value + differenz, 2)
    End If

.
.
hier der VBA-Code zum Drucken des markierten Bereiches
.
.

    ' Ursprüngliche Formeln wieder einfügen
    For Each cell In rng.Columns(2).Cells
        On Error Resume Next
        If Not IsEmpty(originalFormulas.Item(CStr(cell.Address))) Then
            cell.Formula = originalFormulas.Item(CStr(cell.Address))
        End If
        On Error GoTo 0
    Next cell

    ' Ursprüngliche Formel der letzten Zelle wieder einfügen
    If originalFormulaLastCell <> "" Then
        lastCell.Formula = originalFormulaLastCell
    End If

.
.
End Sub