AW: dynamische Tabelle kopieren und einfügen
28.07.2016 19:12:53
Bastian
Hey Berndt =D
Ich hatte gerade etwas langeweile ist zwar ziemlich verwirrend aber es geht hoffe ich;)
Einfach in VBa in Dashboard kopieren das Makro vorhher noch die Ziel Tabelle vom Dashboard Löschen dann das Makro starten .
Gruß Basti
Sub DB()
Dim WSd As Worksheet
Dim WSM As Worksheet
Dim LastWsD As Long
Dim LastWsDF As Long
Dim LastWsM As Long
Dim Rng As Range
Dim zell As Range
Dim ZeitGes As Double
Dim HDay As Double
Application.ScreenUpdating = False
Set WSd = ThisWorkbook.Worksheets("Dashboard")
LastWsDF = WSd.Cells(1048576, 5).End(xlUp).Row
If LastWsDF = 4 Then LastWsDF = 5
HDay = 7
With WSd.Range(WSd.Cells(5, 2), WSd.Cells(LastWsDF + 1, 7))
.Clear
.Borders(xlEdgeLeft).ThemeColor = 1
.Borders(xlEdgeTop).ThemeColor = 1
.Borders(xlEdgeBottom).ThemeColor = 1
.Borders(xlEdgeRight).ThemeColor = 1
.Borders(xlInsideVertical).ThemeColor = 1
.Borders(xlInsideHorizontal).ThemeColor = 1
.RowHeight = 12.75
End With
For Each WSM In ThisWorkbook.Worksheets
LastWsD = WSd.Cells(1048576, 5).End(xlUp).Row + 1
LastWsM = WSM.Cells(1048576, 2).End(xlUp).Row
ZeitGes = 0
If WSM.Name Like "Mitarbeiter*" Then
With WSd
.Cells(LastWsD, 3) = WSM.Name
Set Rng = WSM.Range(WSM.Cells(8, 2), WSM.Cells(LastWsM, 3))
Rng.Copy
.Cells(LastWsD, 5).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
For Each zell In .Range(.Cells(LastWsD, 6), .Cells(LastWsD + Rng.Rows.Count, 6))
ZeitGes = ZeitGes + zell
Next
.Cells(LastWsD, 4) = ZeitGes
.Cells(LastWsD, 4).Offset(1, 0) = HDay
If ZeitGes > HDay Then .Cells(LastWsD, 2).Interior.ColorIndex = 3: .Cells(LastWsD, 2) = " _
Achtung: Zu viele Stunden angegeben! Kapazitätsproblem"
If ZeitGes = HDay Then .Cells(LastWsD, 2).Interior.ColorIndex = 27: .Cells(LastWsD, 2) = " _
Anderen Mitarbeitern kann ich behilflich sein. Freie Kapazitäten"
If ZeitGes