Nach Ablaufdatum suchen auf neuer Seite ausgeben

Hallo Zusammen,

ich versuche mich zur Zeit an Excel VBA und stehe jetzt aber leider an.
Es geht um folgendes Problem.
Da wir keine Datenbank haben um unser Inventarbestand zu überprüfen habe ich ein eigenes File dazu erstellt. Jeder Artikel ist auf einer eigenen Registerkarte (insgesamt so um die 100). Zu jedem Artikel gibt es mehrere Lotnummern und somit unterschiedliche Ablaufdaten und mehrere Zeilen pro Registerblatt.
Das Ablaufdatum befindet sich bei jeder Registerkarte in Spalte B, in Spalte A befindet sich die interne Lotnummer, in Spalte C die Lotnummer des Herstellers und in Spalte F die aktuelle Stückzahl.

Nun zu meiner Frage:
Ist es möglich mit Hilfe eines Buttons sich alle Artikel die abgelaufen sind in einer neuen Registerkarte auflisten zu lassen? Dabei sollen immer die Spalten A bis F aufgelistet werden.
In der neuen Regsterkarte soll ab Zeile 3 mit dem auflisten begonnen werden.

lg,

Thomas

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 8078052166

Url: https://administrator.de/forum/nach-ablaufdatum-suchen-auf-neuer-seite-ausgeben-8078052166.html

Ausgedruckt am: 26.12.2024 um 20:12 Uhr

2 Kommentare

Neuester Kommentar

Hallo,

Zitat von @ThomasV:
Das Ablaufdatum befindet sich bei jeder Registerkarte in Spalte B, in Spalte A befindet sich die interne Lotnummer, in Spalte C die Lotnummer des Herstellers und in Spalte F die aktuelle Stückzahl.

Seit Excel 2007 kann ein Tabellenblatt 1.048.576 Zeilen und 16.384 Spalten (A bis XFD), also 17.179.869.184 Zellen umfassen. Davor war die Größe auf 65.536 Zeilen und 256 Spalten (A bis IV), also 16.777.216 Zellen, begrenzt.

Ist es möglich mit Hilfe eines Buttons sich alle Artikel die abgelaufen sind in einer neuen Registerkarte auflisten zu

lassen? Dabei sollen immer die Spalten A bis F aufgelistet werden.
Ja.
https://learn.microsoft.com/de-de/office/vba/library-reference/concepts/ ...
https://www.vba-tutorial.de/
https://blog.hubspot.de/marketing/excel-vba
usw

Gruß,
Peter

Sub AbgelaufeneAuflisten()
    Dim ws As Worksheet, cell As Range, rngOutput As Range, wsResult As Worksheet
    On Error Resume Next
    Set wsResult = Sheets("Result")  
    On Error GoTo 0
    If wsResult Is Nothing Then
        Set wsResult = Worksheets.Add(Before:=Sheets(1))
        wsResult.Name = "Result"  
    End If
    Set rngOutput = wsResult.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)  
    If rngOutput.Row < 3 Then
        Set rngOutput = wsResult.Range("A3")  
    End If
    
    For Each ws In Sheets
        With ws
            If Not .Name = "Result" Then  
                .UsedRange.AutoFilter Field:=2, Criteria1:=("<" & Format(Date, "yyyy-MM-dd"))  
                .UsedRange.SpecialCells(xlCellTypeVisible).Offset(1, 0).Copy rngOutput
                .UsedRange.AutoFilter
                Set rngOutput = wsResult.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)  
            End If
        End With
    Next
    wsResult.Activate
End Sub