|  
                                             Hallo zusammen, 
Ich will mittels VBA daten aus einer Datei  (SAP Report mit dem Typ Microsoft Excel 97-2003-Arbeitsblatt) in eine andere Excel Datei kopieren. Die Daten enthalten Texte und Zahlen. Die Zahlen in der Quelldatei sind so formatiert, dass es 1000er-Trennpunkte gibt, aber die Zelle trotzdem als Standard formatiert ist. Dafür habe ich nachfolgende VBA erstellt. Das problem ist allerdings, dass beim kopieren der Daten bspw. die Zahl 2.000 als 2,000 eingefügt wird - . Mit meiner Schleife mache ich das Komma weg, so bleibt aber nur eine 2 als Ergebnis übrig, was ja falsch ist. Alle Zahlen die eine Null am Ende haben, werden ohne die Null kopiert: bsp: 2.000 wird zu 2; 1500 wird zu 1,5; 3.350 wird zu 335 usw. Was mache ich falsch? Auch eine Formatierung der Zellen in der Ursprungsdatei in "Genaral" bringt nichts.. Danke für eure Hilfe. Ich kann auch gerne eine Beispieldatei hochladen. 
Sub TP_Edit()
    'T+P aus Drive Ordner kopieren und in Data einfügen
    Dim ZBU3Date As String
    Dim quelleDatei As Workbook
    Dim zielDatei As Workbook
    Dim quelleBereich As Range
    Dim zielBereich As Range
    Dim folderPath As String
    Dim CurrentDate As String
    Dim CurrentWeek As String
    Dim EndDate As String
    folderPath = ActiveWorkbook.ActiveSheet.Range("C9").Value
    ZBU3Date = ActiveWorkbook.ActiveSheet.Range("C18").Value
    CurrentDate = ActiveWorkbook.ActiveSheet.Range("C14").Value
    CurrentWeek = ActiveWorkbook.ActiveSheet.Range("C6").Value
    EndDate = ActiveWorkbook.ActiveSheet.Range("C19").Value
    
    Application.ScreenUpdating = False
    
    Application.DisplayAlerts = False
    'T+P Daten extrahieren
    
    ' Setzen Sie den Pfad zur Quelldatei ein
    Dim quellePfad As String
    quellePfad = folderPath & "\" & "ZBU3_" & ZBU3Date & ".XLS"
    ' Setzen Sie den Pfad zur Zieldatei ein
    Dim zielPfad As String
    zielPfad = folderPath & "\" & "ZBU3W_Master.xlsb"
    ' Öffnen Sie die Quelldatei
    Set quelleDatei = Workbooks.Open(quellePfad)
    
    Range("F3:O5").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.NumberFormat = "General"
    
    ' Öffnen Sie die Zieldatei
    Set zielDatei = Workbooks.Open(zielPfad)
    
    ' Setze den Quellbereich auf der Quelldaten bis zur letzten Zeile
    LetzteZeile = quelleDatei.Sheets("ZBU3_" & ZBU3Date).Cells(Rows.Count, 1).End(xlUp).Row
    ' Definieren Sie den Bereich, den Sie kopieren möchten (angenommen, es sind Daten in Spalte A bis C)
    Set quelleBereich = quelleDatei.Sheets(1).Range("A3:I" & LetzteZeile)
    'Zielbereich der neuen Spalte
    Set zielBereich = zielDatei.Sheets("XLSB").Range("A3:I" & LetzteZeile)
    
    ' Kopiere den Quellbereich in den Zielbereich
    quelleBereich.Copy Destination:=zielBereich
    
    ' Entferne Kommas aus den Zellen im Zielbereich
    Dim cell As Range
    For Each cell In zielBereich
        If InStr(1, cell.Value, ",", vbTextCompare) > 0 Then
            cell.Value = Replace(cell.Value, ",", "")
        End If
    Next cell
    ' Definieren Sie den Bereich, den Sie kopieren möchten (angenommen, es sind Daten in Spalte A bis C)
    Set quelleBereich = quelleDatei.Sheets(1).Range("J3:S" & LetzteZeile)
    'Zielbereich der neuen Spalte
    Set zielBereich = zielDatei.Sheets("XLSB").Range("M3:V" & LetzteZeile)
    
    ' Kopiere den Quellbereich in den Zielbereich
    quelleBereich.Copy Destination:=zielBereich
    
    'Formeln runterziehen
    Range("J3:L3").Select
    Selection.AutoFill Destination:=Range("J3:L" & LetzteZeile), Type:=xlFillDefault
    
    'Filter einsetzen
    ActiveWorkbook.Sheets("XLSB").Range("A2:V2").AutoFilter Field:=12, Criteria1:="<>0"
    ' Schließt ZBU3 Datei ohne zu speichern
    quelleDatei.Close SaveChanges:=False
    
    'Speichert ZBU3W P+T Datei
    zielDatei.SaveAs folderPath & "\" & "ZBU3W_" & CurrentDate & " P+T " & CurrentWeek & "-" & EndDate & ".xlsb", FileFormat:=50
    
    zielDatei.Close SaveChanges:=False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub
  
     |