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
|