VBA-Forum - Das Forum zu Microsoft VBA

VBA Excel VBA Word VBA Access VBA VBScript VB C# Objective-C C++ SQL JAVA VBA (English) Jobs Übersicht

Thema	Datum	Von Nutzer	Rating	Antwort
Tabellenblätter filtern und auf ein neues Blatt ausgeben	01.02.2021 09:30:52	Adhurim
Tabellenblätter filtern und auf ein neues Blatt ausgeben	01.02.2021 09:38:35	Werner
ach ja....	01.02.2021 09:42:43	Werner
Tabellenblätter filtern und auf ein neues Blatt ausgeben	01.02.2021 10:05:40	Adhurim
Tabellenblätter filtern und auf ein neues Blatt ausgeben	01.02.2021 10:27:37	Werner
kurz nachgefragt	01.02.2021 12:43:40	ralf_b
kurz nachgefragt	01.02.2021 12:48:09	Werner

Ansicht des Beitrags:

Von:
Werner

Datum:
01.02.2021 10:27:37

Views:
695

Rating:

Antwort:

Thema:
Tabellenblätter filtern und auf ein neues Blatt ausgeben

Hallo,

Sub Schaltfläche1_Klicken()
Dim ws As Worksheet

Application.ScreenUpdating = False

For Each ws In ThisWorkbook.Worksheets
    'Blattname Zielblatt anpassen
    If ws.Name <> "Zusammenfassung" Then
        With ws
            .Range("A11").AutoFilter Field:=12, Criteria1:=Array("A", "B", "C"), Operator:=xlFilterValues
            If .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
                With .AutoFilter.Range
                    .Offset(1).Resize(.Rows.Count - 1).Copy
                    With Worksheets("Zusammenfassung")
                        .Cells(.Cells(.Rows.Count, "A").End(xlUp).Offset(1).Row, "A").PasteSpecial _
                        Paste:=xlPasteValuesAndNumberFormats
                    End With
                End With
            End If
            .Range("A2").AutoFilter
        End With
    End If
Next ws

Application.CutCopyMode = False
End Sub

Gruß Werner

Ihre Antwort

Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema:		Name:		Email:

Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema	Datum	Von Nutzer	Rating	Antwort
Tabellenblätter filtern und auf ein neues Blatt ausgeben	01.02.2021 09:30:52	Adhurim
Tabellenblätter filtern und auf ein neues Blatt ausgeben	01.02.2021 09:38:35	Werner
ach ja....	01.02.2021 09:42:43	Werner
Tabellenblätter filtern und auf ein neues Blatt ausgeben	01.02.2021 10:05:40	Adhurim
Tabellenblätter filtern und auf ein neues Blatt ausgeben	01.02.2021 10:27:37	Werner
kurz nachgefragt	01.02.2021 12:43:40	ralf_b
kurz nachgefragt	01.02.2021 12:48:09	Werner