Hallo zusammen,
ich bin neu im VBA-Bereich und wende mich mal nun an euch. Das Problem: Habe 4 identisch aufgebaute Excel-Dateien mit jeweils 15 Tabellenblätter. Nun möchte ich aus den vier Dateien das erste Blatt in einer neuen Master-Datei auf dem ersten Blatt untereinander darstellen. Hierbei sollen allerdings nur diejenigen Zellen kopiert werden, die auch benutzt wurden (UsedRange?). Hinzu möchte ich gerne noch, dass nicht die Formeln aus den Ursprungsdateien sondern nur die Werte kopiert werden. Bisher habe ich dies:
Public Sub Total_monthly_summary()
On Error GoTo errExit
Dim WBQ As Workbook
Dim WBZ As Workbook
Dim varDateien As Variant
Dim lngAnzahl As Long
Dim lngLastQ As Long
Set WBZ = ActiveWorkbook
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
For lngAnzahl = LBound(varDateien) To UBound(varDateien)
Set WBQ = Workbooks.Open(Filename:=varDateien(lngAnzahl))
lngLastQ = WBQ.Worksheets(1).Range("A65536").End(xlUp).Row
WBQ.Worksheets(1).Range("A2:Z" & lngLastQ).Copy _
Destination:=WBZ.Worksheets(1).Range("A" & WBZ.Worksheets(1).Range("A65536").End(xlUp).Row + 1)
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
Leider kopiert er mir bisher noch alle Zeilen, egal ob genutzt oder nicht und er kopiert die gesamten Formeln - kann mir jemand weiterhelfen?
Viele Grüße
Laura
|