|
Hallo ihr Lieben,
ich habe ein Problem und zwar bin ich mittlerweile auch etwas in Zugzwang.
Ich habe eine Aufgabenliste für mehrere Mitarbeiter (+ Übersicht für Chef) per Makro erstellt und wollte diese eigentlich in SharePoint einbinden als eine Datei.
Problem: Das geht nun nicht über Excel Online.
Bisher ist das Makro so gestrickt, dass ich die einzelnen Tabellenblätter aus der gleichen Arbeitsmappe abfrage.
Es handelt sich hierbei um gleich aussehende Tabellen mit vielen Formeln drin.
Die erste Zeile jeder Tabelle (Daten, nicht Überschrift) ist immer C18.
Das Ende ist .. Nunja.. So viel halt derzeit mit drin ist. :-)
Ich habe jetzt alle Tabellen der Arbeitsblätter in einzelne Arbeitsmappen abgespeichert.
Ich benötige nun Hilfe dabei mit dem Makro.
Ich möchte, dass der Chef einfach nur einen Knopf drücken muss und sich die Excel alle Info´s aus den jeweiligen Arbeitsmappen bzw. Tabellen herauszieht, sodass er eine grobe Übersicht über die Aufgabenverteilung + Stand direkt bekommt.
Ich dachte mir nun, dass ich das anstatt per SharePoint auf dem Firmenlaufwerk, in das sich sowieso jeder per VPN einwählen kann, abspeichere.
Mein derzeitiger Code für das Abfragen innerhalb der einen Arbeitsmappe ist:
Option Explicit<pre>
Sub Zusammenführen()
Dim arrLists() As ListObject
Dim intList As Integer
Dim Spalte As Long, Zeile As Long, Zeilen As Long, StatusCalc As Long
Dim wks As Worksheet
'Infos zu den Tabellen sammeln
Zeilen = 0
For Each wks In ThisWorkbook.Worksheets
Select Case wks.Name
Case Me.Name, "Name,Name,Name,Name,Name"
'ggf. weitere Tabellennamen ergänzen
'diese Tabellenblätter nicht übernehmen
Case Else
intList = intList + 1
ReDim Preserve arrLists(1 To intList)
Set arrLists(intList) = wks.ListObjects(1)
Zeilen = Zeilen + arrLists(intList).DataBodyRange.Rows.Count
End Select
Next
If intList > 0 Then
'Makrobremsen lösen
With Application
.ScreenUpdating = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
.EnableEvents = False
End With
With Me
'Liste an Gesamtzahl der Zeilen in den Tabellen anpassen
With .ListObjects(1)
Zeile = .Range.Row
Spalte = .Range.Column
.DataBodyRange.ClearContents
End With
.ListObjects(1).Resize .Range(.Cells(Zeile, Spalte), _
.Cells(Zeile + Zeilen, Spalte + arrLists(intList).Range.Columns.Count - 1))
'Daten in den Tabellen als Werte in die Übersicht kopieren
Zeile = Zeile + 1
For intList = LBound(arrLists) To UBound(arrLists)
With arrLists(intList).DataBodyRange
.Copy
Me.Cells(Zeile, Spalte).PasteSpecial Paste:=xlPasteValues
Zeile = Zeile + .Rows.Count
End With
Next
Range("A18").Select
End With
'Makrobremsen zurücksetzen
With Application
.ScreenUpdating = True
If StatusCalc <> .Calculation Then .Calculation = StatusCalc
.EnableEvents = True
End With
End If
End Sub</pre>
Ich hoffe ihr könnt mir auch ein so einem schönen sonnigen Sonntag helfen. :)
LG
Felix
|