Nochmal: Hilfe zu bestehendem Code
04.06.2013 21:01:32
Chris
ich möchte mehrere Excel-Datein aus einem Ordner zu einer Datei zusammenführen. Jede Datei hat einen recht ähnlichen aufbau mit mehreren Arbeitsblättern. Der (wahrscheinlich bereits bekannte) Code hier unten leistet genau dies. Mein Problem: In den Tabellenblättern befinden sich teilweise Formeln mit festen Bezügen. Nach der Zusammenführung sind diese natürlich nutzlos.
Daher meine Frage:
Gibt es eine Möglichkeit den Code so zu verändern, dass nicht die Formeln mitkopiert werden sondern nur die reinen Werte? (so wie bei Inhalt einfüge, Werte).
Danke für eure Hilfe.
Public Sub Daten_mehrerer_Dateien_zusammenfuehren2()
'Code für ein allgemeines Modul
'Autor: Jürgen Hennekes
On Error GoTo errExit
Dim WBQ As Workbook
Dim WBZ As Workbook
Dim intSh As Integer
Dim varDateien As Variant
Dim lngAnzahl As Long
Dim lngLastQ As Long
Set WBZ = ActiveWorkbook
'Altdaten auf Zielblatt löschen
WBZ.Worksheets(1).Range("A2:IV65536").ClearContents
varDateien = _
Application.GetOpenFilename("Datei (*.xls),*.xls", False, "Bitte gewünschte Datei(en) markieren" _
_
_
, False, True)
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
For lngAnzahl = LBound(varDateien) To UBound(varDateien)
Set WBQ = Workbooks.Open(Filename:=varDateien(lngAnzahl))
For intSh = 1 To WBQ.Worksheets.Count
lngLastQ = WBQ.Worksheets(intSh).Range("A65536").End(xlUp).Row
WBQ.Worksheets(intSh).Range("A2:Z" & lngLastQ).Copy _
Destination:=WBZ.Worksheets(1).Range("A" & WBZ.Worksheets(1).Range("A65536").End(xlUp). _
Row + 1)
Next
WBQ.Close
Next
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
MsgBox "Es wurden " & UBound(varDateien) & " Dateien zusammengefügt.", 64
Exit Sub
errExit:
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
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