Hallo,
ich habe ein Reihe von identischen Dateien, welche alle ein Punktdiagramm enthalten. Nun möchte ich diese Diagramme alle in einem neuen Diagramm in einer neuen Datei zusammenfasssen. Mein Lösungsansatz ist wie folgt:
Public Sub Daten_mehrerer_Dateien_zusammenfuehren()
Dim WBQ As Workbook
Dim WBZ As Workbook
Dim varDateien As Variant
Dim lngAnzahl As Long
Set WBZ = ActiveWorkbook
'Formatieren der aktuellen Datei
Charts.Add.Name = "Gesamt"
Sheets("Gesamt").Select
ActiveChart.ChartType = xlXYScatterSmoothNoMarkers
Application.DisplayAlerts = False
Worksheets("Tabelle1").Delete
Worksheets("Tabelle2").Delete
Worksheets("Tabelle3").Delete
Application.DisplayAlerts = True
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))
WBQ.Worksheets("PQ-Kennlinie").ChartObjects(1).Copy _
Destination:=WBZ.Worksheets("Gesamt").Paste
WBQ.Close
Next
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
MsgBox "Es wurden " & UBound(varDateien) & " Dateien zusammengefügt.", 64
End Sub
Wie kann ich den Code verändern, sodass es funktioniert?
|