Daten mit Formel aus anderen Exceldateien auslesen
08.06.2018 11:01:30
Florian
ich bin ziemlich neu mit VBA und brauche eure Hilfe.
Ziel: Daten aus anderen Excel auslesen und in ein anderes Excel einfügen. Das funktioniert auch mit dem Code unten.
Problem: bei Daten mit Formeln aus der Quell-Exceldatei bekomme ich den Wert 0 statt der errechneten Zahl. Allerdings erst wenn ich die Zieldatei speichere. Davor stimmt der ausgelesene Wert.
Gibt es hier eine Möglichkeit wie ich doch den errechneten Wert beibehalten kann?
Vielen Dank schon einmal für eure Hilfe!!
LG, Florian
Hier der verwendete Code:
Public Sub Daten_mehrerer_Dateien_zusammenfuehren()
' Mehrere Dateien einlesen und in einzelne Felder und Zeilen übertragen
On Error GoTo errExit
Dim WBQ As Workbook
Dim WBZ As Workbook
Dim varDateien As Variant
Dim lngAnzahl As Long
Dim lngLastQ As Long
Dim lngCurrentQ As Long
Set WBZ = ActiveWorkbook
Sheets("Zeilen").Select
' Dateien öffnen (mehrere möglich)
varDateien = Application.GetOpenFilename("Datei (*.xlsx),*.xlsx", False, "Bitte gewünschte _
Datei(en) markieren", False, True)
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
' Ausgaben mit Zeile 5 beginnen
lngCurrentQ = 5
' Dateien einlesen und übertragen
For lngAnzahl = LBound(varDateien) To UBound(varDateien)
Set WBQ = Workbooks.Open(Filename:=varDateien(lngAnzahl))
'Copy ID
WBQ.Worksheets(1).Range("D7:D7").Copy _
Destination:=WBZ.Worksheets(1).Range("A" & lngCurrentQ)
'Copy Projectname
WBQ.Worksheets(1).Range("D5:D5").Copy _
Destination:=WBZ.Worksheets(1).Range("B" & lngCurrentQ)
'Copy Business WD local Total
WBQ.Worksheets(1).Range("S116:S116").Copy _
Destination:=WBZ.Worksheets(1).Range("BT" & lngCurrentQ)
'Copy Business WD HQ Total
WBQ.Worksheets(1).Range("S117:S117").Copy _
Destination:=WBZ.Worksheets(1).Range("CA" & lngCurrentQ)
lngCurrentQ = lngCurrentQ + 1
WBQ.Close
Next
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationManual
End With
MsgBox "Es wurden " & UBound(varDateien) & " Dateien zusammengefügt.", 64
Exit Sub
errExit:
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationManual
End With
If Err.Number = 13 Then
MsgBox "Es wurde keine Datei ausgewählt"
Else
MsgBox "Es ist ein Fehler aufgetreten!" & vbCr _
& "Fehlernummer: " & Err.Number & vbCr _
& "Fehlerbeschreibung: " & Err.Description
End If
End Sub