Excel: Filtern aus mehreren Arbeitsblättern mit Ergebniss in einem neuen AB

Dieses Thema Excel: Filtern aus mehreren Arbeitsblättern mit Ergebniss in einem neuen AB im Forum "Windows XP Forum" wurde erstellt von batze, 30. Jan. 2008.

Thema: Excel: Filtern aus mehreren Arbeitsblättern mit Ergebniss in einem neuen AB Hallo, wie kann man realisieren, dass die Datensätze mehrer Tabellenblätter, welche z. B. in der Tabelle 3 in der...

  1. Hallo,
    wie kann man realisieren, dass die Datensätze mehrer Tabellenblätter, welche z. B. in der Tabelle 3 in der Spalte K ein E und in der Spalte N ein x stehen haben (es soll auch Tabelle 1 u. Tabelle 2 nach gleichen Kriterien durchsucht werden) in einem neuen Tabellenblatt (z. B. Tabelle 4) eingetragen werden.
    Es sollen also alle Tabellenblätter nach den beiden Kriterien durchsucht und in eine neue Tabelle (nicht Datei) geschrieben werden.
    Das ganze sollte beim öffnen der Datei ausgeführt werden. Hat da jemand eine Idee?
    Danke schon mal im voraus.

    batze
     
  2. Hallo batze,

    das sollte mit folgendem Makro gehen. Den packst du in ein Modul deiner Arbeitsmappe.
    Code:
    Option Explicit
    
    Sub BlattErstellenMitKgleichEundNgleichxAufBlatt1Und2()
    
     Const cBericht_BLATTNAME = BERICHT_E_x->Zielblatt
     Const cZ_UEB = 1->Überschriftenzeile
     Const cZ_AB = 2->Zeilen sind zu finden ab Zeile:
     Const cSP_K = 11->Spalte K
     Const cSP_K_TXT = E
     Const cSP_N = 14->Spalte N
     Const cSP_N_TXT = x
     
     
     Dim QuellBlaetter As Variant
    ->Quellblaetter (müssen alle das gleiche Format haben)
     QuellBlaetter = Array(Tabelle 3, Tabelle 4)
     
     Dim ws As Worksheet, wsq As Worksheet, Zelle As Range, r As Range
     Dim zz As Long, lCols As Long, lRows As Long, sp As Long, x As Long
     Dim ersterFundort As String
     
     Application.ScreenUpdating = False
     
    ->ggf. vorhandenes Berichtsblatt löschen
     On Error Resume Next
     Set ws = ThisWorkbook.Worksheets(cBericht_BLATTNAME)
     Application.DisplayAlerts = False
     ws.Delete
     Application.DisplayAlerts = True
     On Error GoTo 0
     
    ->Berichtsblatt anlegen
     Set ws = ThisWorkbook.Worksheets.Add(Before:=ThisWorkbook.Worksheets(1))
    
     ws.Name = cBericht_BLATTNAME
    ->Format und Überschrift kopieren aus 1.Blatt
     Set wsq = ThisWorkbook.Worksheets(QuellBlaetter(0))
     lCols = wsq.UsedRange.Column + wsq.UsedRange.Columns.Count - 1-> Anzahl benutzte Spalten
     For sp = 1 To lCols
      ws.Columns(sp).NumberFormat = wsq.Cells(cZ_AB, sp).NumberFormat
      ws.Columns(sp).ColumnWidth = wsq.Cells(cZ_AB, sp).ColumnWidth
      ws.Cells(cZ_UEB, sp).NumberFormat = wsq.Cells(cZ_UEB, sp).NumberFormat
      ws.Cells(cZ_UEB, sp).Value = wsq.Cells(cZ_UEB, sp).Value
      ws.Cells(cZ_UEB, sp).Font.Bold = wsq.Cells(cZ_UEB, sp).Font.Bold
     Next
     zz = cZ_UEB->augenblickliche Zeile auf Bericht
     
    ->Aus Blättern relevante zeilen kopieren
     For x = LBound(QuellBlaetter) To UBound(QuellBlaetter)
      Set wsq = ThisWorkbook.Worksheets(QuellBlaetter(x))
      lRows = wsq.UsedRange.Row + wsq.UsedRange.Rows.Count - 1-> Anzahl benutzte Zeilen
      If lRows >= cZ_AB Then
       
      ->relevante Zeilen suchen
       Set r = wsq.Range(wsq.Cells(cZ_AB, cSP_K), wsq.Cells(lRows, cSP_K))
       
       Set Zelle = r.Find( _
        What:=cSP_K_TXT, _
        After:=ws.Cells(lRows, cSP_K), _
        LookIn:=xlValues, _
        LookAt:=xlWhole)
        
       If Not Zelle Is Nothing Then
        ersterFundort = Zelle.Address
        Do
         If wsq.Cells(Zelle.Row, cSP_N).Value = cSP_N_TXT Then
         ->Werte der Zeile auf Berichtsblatt übertragen
          wsq.Range(wsq.Cells(Zelle.Row, 1), wsq.Cells(Zelle.Row, lCols)).Copy
          zz = zz + 1
          ws.Activate
          ws.Cells(zz, 1).Select
          Selection.PasteSpecial Paste:=xlPasteValues
         End If
         Set Zelle = r.FindNext(Zelle)
        Loop While Not Zelle Is Nothing And Zelle.Address <> ersterFundort
        
       End If
      End If
      Application.CutCopyMode = False
      wsq.Activate
      wsq.Range(A1).Select
     Next
     ws.Activate
     ws.Range(A1).Select
     
     Application.ScreenUpdating = True
    
    AUFRAEUMEN:
     Set ws = Nothing: Set wsq = Nothing: Set Zelle = Nothing: Set r = Nothing
    End Sub
    Die Namen deiner Quellblätter im Array QuellBlaetter noch anpassen und schon kannst du mit Aufruf des Makros ausprobieren, ob du einen Bericht-Blatt erhälst.

    Wenn das klappt, schreibst du in die Code-Seite der Arbetsmappe(DieseArbeitsmappe) folgendes Makro
    Code:
    Private Sub Workbook_Open()
     Call BlattErstellenMitKgleichEundNgleichxAufBlatt1Und2
    End Sub
    Damit wird das Makro beim Öffnen der Arbeitsmappe aufgerufen.

    Gruß Matjes :)
     
Die Seite wird geladen...

Excel: Filtern aus mehreren Arbeitsblättern mit Ergebniss in einem neuen AB - Ähnliche Themen

Forum Datum
Excel 2007: Filtern von Tabellen...altes DropDown möglich? Windows XP Forum 16. Feb. 2011
Daten aus Excel ausfiltern und webbasiert darstellen! Windows XP Forum 5. Juni 2006
Doppelte Einträge in Excellisten filtern Windows XP Forum 23. Jan. 2006
Excel: Zeilen mit doppeltem Inhalt filtern Windows XP Forum 16. Dez. 2003
Excel-Feature gesucht Microsoft Office Suite 11. Okt. 2016