Overview Verweis mit Update button

Hallo liebe Excel Gurus,
Vorerst wünsche ich euch allen ein schönes neues Jahr und viel Erfolg in diesem
Ich bin zum ersten Mal hier und bräuchte eure Hilfe. Ich wurde vor eine spannende Aufgabe gestellt allerdings schaffe ich es nicht alleine da ich mich bei VBA null auskenne Versuche es aber zu lernen.
Es handelt sich dabei um ein Excel File mit mehreren Reitern welche in einem Overview zusammengefasst werden sollen.
Jede dieser Reiter hat einen Namen und mehrere Einträge mit diversen Spalten. Z.B.: Nummer | Name | Beschreibung | Status....
Im Overview sollen alle Reiter untereinander dargestellt werden. (Als Art Überschrift). Unter der Reiterbezeichnung sollen nun alle Einträge mit dem Status (Nicht: Abgeschlossen) angezeigt werden. Sprich: Wie mit SVERWEIS sollen alle Daten des Eintrags im Overview dargestellt werden.
Beispiel des Overviews:
Update Button
Allgemein
Nummer des ersten Eintrags | Name des ersten Eintrags | Beschreibung des ersten Eintrags | Status des ersten Eintrags
Nummer des zweiten Eintrags | Name des zweiten Eintrags | Beschreibung des zweiten Eintrags | Status des zweiten Eintrags
Reiter 1
Nummer des ersten Eintrags | Name des ersten Eintrags | Beschreibung des ersten Eintrags | Status des ersten Eintrags
.
.
.
Der "Update Button" soll beim betätigen alle Einträge (nicht die Reiter Kategorisierung) im Overview löschen, den Status jeder einzelnen Einträge checken und falls bei einem Eintrag im Status nicht "Abgeschlossen" steht, sollen alle Daten des Eintrages im Overview unter dem richtigen Reiter reinkopiert werden.
Ich hoffe ich habe es verständlich geschrieben.
Ich habe noch ein Beispielsfile hochgeladen: https://www.herber.de/bbs/user/126478.xlsm
Hoffe mit dem ist es etwas verständlicher.
Vielen Dank jetzt schon mal für eure Hilfe!
Liebe Grüße
Robert

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Public Sub Update() Dim loLetzte As Long, loLetzteZiel As Long, ws As Worksheet, wsZiel As Worksheet Set wsZiel = ThisWorkbook.Worksheets("Overview") Application.ScreenUpdating = False With wsZiel If .Cells(4, 1) "" Then loLetzteZiel = .Cells(.Rows.Count, 1).End(xlUp).Row .Range(.Cells(4, 1), .Cells(loLetzteZiel, 15)).Delete End If End With For Each ws In ThisWorkbook.Worksheets If ws.Name "Overview" Then With ws loLetzte = .Cells(.Rows.Count, 12).End(xlUp).Row If .FilterMode Then .ShowAllData If WorksheetFunction.CountIf(.Columns(12), "Abgeschlossen") > 0 Then .Range(.Cells(4, 1), .Cells(loLetzte, 15)).AutoFilter field:=12, Criteria1:= _ "Abgeschlossen" With .AutoFilter.Range .Resize(.Rows.Count - 1).Offset(1, 0).Copy End With With wsZiel loLetzteZiel = .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Row .Cells(loLetzteZiel, 1) = ws.Name .Cells(loLetzteZiel, 1).Font.Color = vbWhite .Range(.Cells(loLetzteZiel, 1), .Cells(loLetzteZiel, 15)).Interior. _ Color = vbBlack loLetzteZiel = loLetzteZiel + 1 .Cells(loLetzteZiel, 1).PasteSpecial Paste:=xlPasteValues End With If .FilterMode Then .ShowAllData End If End With End If Next ws wsZiel.Range("A4").Select Application.CutCopyMode = False Set wsZiel = Nothing End Sub

Hallo Robert,
Denkfehler meinerseits - teste mal:

Option Explicit
Public Sub Update()
Dim loLetzte As Long, loLetzteZiel As Long, ws As Worksheet, wsZiel As Worksheet
Application.ScreenUpdating = False
Set wsZiel = ThisWorkbook.Worksheets("Overview")
With wsZiel
If .Cells(4, 1)  "" Then
loLetzteZiel = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range(.Cells(4, 1), .Cells(loLetzteZiel, 15)).Delete
End If
End With
For Each ws In ThisWorkbook.Worksheets
If ws.Name  "Overview" Then
With ws
.Select
.Range("A4").Select
If .FilterMode Then .ShowAllData
loLetzte = .Columns(1).Find(what:="*", LookIn:=xlValues, LookAt:=xlWhole, _
SearchDirection:=xlPrevious).Row
If loLetzte > 4 Then
If WorksheetFunction.CountIf(.Columns(12), "Abgeschlossen") = 0 Then
.Range(.Cells(5, 1), .Cells(loLetzte, 15)).Copy
With wsZiel
loLetzteZiel = .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Row
.Cells(loLetzteZiel + 1, 1).PasteSpecial Paste:=xlPasteValues
.Cells(loLetzteZiel, 1) = ws.Name
.Cells(loLetzteZiel, 1).Font.Color = vbWhite
.Cells(loLetzteZiel, 1).Font.Bold = True
.Range(.Cells(loLetzteZiel, 1), .Cells(loLetzteZiel, 15)) _
.Interior.Color = vbBlack
End With
ElseIf WorksheetFunction.CountIf(.Columns(12), "Abgeschlossen") "
.Range(.Cells(5, 1), .Cells(loLetzte, 15)).AutoFilter 12, "Abgeschlossen"
With .AutoFilter.Range
.Resize(.Rows.Count - 1).Offset(1).Copy
With wsZiel
loLetzteZiel = .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Row
.Cells(loLetzteZiel + 1, 1).PasteSpecial Paste:=xlPasteValues
.Cells(loLetzteZiel, 1) = ws.Name
.Cells(loLetzteZiel, 1).Font.Color = vbWhite
.Cells(loLetzteZiel, 1).Font.Bold = True
.Range(.Cells(loLetzteZiel, 1), .Cells(loLetzteZiel, 15)) _
.Interior.Color = vbBlack
End With
End With
End If
End If
If .FilterMode Then .ShowAllData
End With
End If
Next ws
wsZiel.Activate
wsZiel.Range("A3").Select
Application.CutCopyMode = False
Set wsZiel = Nothing
End Sub

Gruß Werner

Beliebteste Forumthreads (12 Monate)

Overview Verweis mit Update button

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread