Clever-Excel-Forum

Hallo zusammen,

ich benutze momentan folgendes Makro (was auch super funktioniert):

Code:
Sub Werte_Übertragen()

  Dim Maßblatt As Object

  Dim Lastenheft As Object

  Dim sDatei As String

'Bildschirmaktualisierung ausschalten

     Application.ScreenUpdating = False

'Zieldatei festlegen

     Set Maßblatt = ActiveWorkbook

'Datei festlegen, öffnen und Daten übertragen

     ChDir ThisWorkbook.Path

     sDatei = Application.GetOpenFilename(, , "LH auswählen", , False)

'Wenn Öffnen abgebrochen wird

     If sDatei = "Falsch" Then Exit Sub

'Nur lesend öffnen

     Set Lastenheft = Workbooks.Open(sDatei, False, True)

'Übertragungen von einzelnen Zellen:

    Maßblatt.Sheets("Übergabe LH").Range("B1").Value = Lastenheft.Sheets("Lastenheft").Range("D15").Value

    Maßblatt.Sheets("Übergabe LH").Range("B2").Value = Lastenheft.Sheets("Lastenheft").Range("D17").Value

    Maßblatt.Sheets("Übergabe LH").Range("B3").Value = Lastenheft.Sheets("Lastenheft").Range("E189").Value

    Maßblatt.Sheets("Übergabe LH").Range("B4").Value = Lastenheft.Sheets("Lastenheft").Range("F189").Value

    Maßblatt.Sheets("Übergabe LH").Range("B5").Value = Lastenheft.Sheets("Lastenheft").Range("G189").Value

    Maßblatt.Sheets("Übergabe LH").Range("B6").Value = Lastenheft.Sheets("Lastenheft").Range("D201").Value

    Maßblatt.Sheets("Übergabe LH").Range("B7").Value = Lastenheft.Sheets("Lastenheft").Range("D203").Value

    Maßblatt.Sheets("Übergabe LH").Range("B8").Value = Lastenheft.Sheets("Lastenheft").Range("D205").Value

    Maßblatt.Sheets("Übergabe LH").Range("B9").Value = Lastenheft.Sheets("Lastenheft").Range("D236").Value

    Maßblatt.Sheets("Übergabe LH").Range("B10").Value = Lastenheft.Sheets("Lastenheft").Range("E238").Value

    Maßblatt.Sheets("Übergabe LH").Range("B11").Value = Lastenheft.Sheets("Lastenheft").Range("E240").Value

    Maßblatt.Sheets("Übergabe LH").Range("B12").Value = Lastenheft.Sheets("Lastenheft").Range("G22").Value

    Maßblatt.Sheets("Übergabe LH").Range("B13").Value = Lastenheft.Sheets("Lastenheft").Range("D159").Value

    Maßblatt.Sheets("Übergabe LH").Range("B14").Value = Lastenheft.Sheets("Lastenheft").Range("E164").Value

    Maßblatt.Sheets("Übergabe LH").Range("B15").Value = Lastenheft.Sheets("Lastenheft").Range("E196").Value

    Maßblatt.Sheets("Übergabe LH").Range("B16").Value = Lastenheft.Sheets("Lastenheft").Range("D252").Value

    Maßblatt.Sheets("Übergabe LH").Range("B18").Value = Lastenheft.Sheets("Lastenheft").Range("F247").Value

    Maßblatt.Sheets("Übergabe LH").Range("B19").Value = Lastenheft.Sheets("Lastenheft").Range("G247").Value

    Maßblatt.Sheets("Übergabe LH").Range("B21").Value = Lastenheft.Sheets("Lastenheft").Range("F246").Value

    Maßblatt.Sheets("Übergabe LH").Range("B22").Value = Lastenheft.Sheets("Lastenheft").Range("G246").Value

'nicht speichern

     Lastenheft.Close False

'Bildschirmaktualisierung einschalten

     Application.ScreenUpdating = True

'Variablen aufräumen

     Set Maßblatt = Nothing

     Set Lastenheft = Nothing

End Sub

In der Quelldatei kopiere ich eigentlich nur Zahlenwerte. Jetzt ist es aber so, dass manchmal die Zahlen mit einem Komma stehen und manchmal mit einem Punkt.
In der Zieldatei müssen aber alle Zahlenwerte immer mit einem Komma stehen.

Wie kann ich das Makro so anpassen, dass ein Punkt durch ein Komma ersetzt wird?

Vielen dank im Voraus

Hallo,

Code:
Sub Werte_Uebertragen()

  Dim Maßblatt As Object

  Dim Lastenheft As Object

  Dim sDatei As String

'Bildschirmaktualisierung ausschalten

     Application.ScreenUpdating = False

'Zieldatei festlegen

     Set Maßblatt = ActiveWorkbook.Sheets("Übergabe LH")

'Datei festlegen, öffnen und Daten übertragen

     ChDir ThisWorkbook.Path

     sDatei = Application.GetOpenFilename(, , "LH auswählen", , False)

'Wenn Öffnen abgebrochen wird

     If CVar(sDatei) = False Then Exit Sub

'Nur lesend öffnen

     Set Lastenheft = Workbooks.Open(sDatei, False, True).Sheets("Lastenheft")

'Übertragungen von einzelnen Zellen:

    Maßblatt.Range("B1").Value = Replace(Lastenheft.Range("D15").Value, ".", ",")

    Maßblatt.Range("B2").Value = Replace(Lastenheft.Range("D17").Value, ".", ",")

    Maßblatt.Range("B3").Value = Replace(Lastenheft.Range("E189").Value, ".", ",")

    Maßblatt.Range("B4").Value = Replace(Lastenheft.Range("F189").Value, ".", ",")

    Maßblatt.Range("B5").Value = Replace(Lastenheft.Range("G189").Value, ".", ",")

    Maßblatt.Range("B6").Value = Replace(Lastenheft.Range("D201").Value, ".", ",")

    Maßblatt.Range("B7").Value = Replace(Lastenheft.Range("D203").Value, ".", ",")

    Maßblatt.Range("B8").Value = Replace(Lastenheft.Range("D205").Value, ".", ",")

    Maßblatt.Range("B9").Value = Replace(Lastenheft.Range("D236").Value, ".", ",")

    Maßblatt.Range("B10").Value = Replace(Lastenheft.Range("E238").Value, ".", ",")

    Maßblatt.Range("B11").Value = Replace(Lastenheft.Range("E240").Value, ".", ",")

    Maßblatt.Range("B12").Value = Replace(Lastenheft.Range("G22").Value, ".", ",")

    Maßblatt.Range("B13").Value = Replace(Lastenheft.Range("D159").Value, ".", ",")

    Maßblatt.Range("B14").Value = Replace(Lastenheft.Range("E164").Value, ".", ",")

    Maßblatt.Range("B15").Value = Replace(Lastenheft.Range("E196").Value, ".", ",")

    Maßblatt.Range("B16").Value = Replace(Lastenheft.Range("D252").Value, ".", ",")

    Maßblatt.Range("B18").Value = Replace(Lastenheft.Range("F247").Value, ".", ",")

    Maßblatt.Range("B19").Value = Replace(Lastenheft.Range("G247").Value, ".", ",")

    Maßblatt.Range("B21").Value = Replace(Lastenheft.Range("F246").Value, ".", ",")

    Maßblatt.Range("B22").Value = Replace(Lastenheft.Range("G246").Value, ".", ",")

'nicht speichern

     Lastenheft.Parent.Close False

'Bildschirmaktualisierung einschalten

     Application.ScreenUpdating = True

'Variablen aufräumen

     Set Maßblatt = Nothing

     Set Lastenheft = Nothing

End Sub

Gruß Uwe

DeLaGhetto

Kuwer