Excel-Preisliste, Export als CSV. Eine Zeile, mehrere Spalten, gleicher Wert

Sub Export()
    Dim objFile As Object, fso As Object, FILENAME As Variant
    FILENAME = Application.GetSaveAsFilename(FileFilter:="CSV-Datei (*.csv),*.csv")  
    If FILENAME <> False Then
        'FS Object erstellen  
        Set fso = CreateObject("Scripting.FileSystemObject")  
        'Ausgabedatei erstellen  
        Set objFile = fso.OpenTextFile(FILENAME, 2, True)
        
        With ActiveSheet
            'Überschriften ermitteln  
            Set rngHeader = .Range("B1", .Cells(1, Columns.Count).End(xlToLeft))  
            'Für jede belegte Zeile in Spalte A  
            For Each r In .Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)  
                'Schreibe für jeden Artikel und Spalte eine neue Zeile  
                For Each c In rngHeader
                    objFile.WriteLine r.Value & ";" & c.Value & ";" & r.Offset(0, c.Column - 1).Value  
                Next
            Next
            'Ausgabedatei schließen  
            objFile.Close
        End With
    Else
        MsgBox "Keine Dateiname vergeben, Abbruch.", vbExclamation  
    End If
End Sub