Zeilen aus Datenbank in neue Tabelle filtern

Hallo,

ich versuche schon eine Weile nachfolgendes zu lösen, es ist mir leider noch nicht gelungen. Kann jemand helfen? Ich würde mich freuen.

Ich habe eine komplexe Datenbank, in der sich bestimmte Zellen (mit Zahlen) automatisch verändern. Bis jetzt habe ich diese Zellen mit einer bedingten Formatierung versehen, so dass sie, wenn sie sich in einem bestimmten Prozentsatz zu einer anderen Zelle der gleichen Zeile verändern, rot hinterlegt sind.

Zur besseren Übersicht, möchte ich die kompletten Zeilen mit den entsprechend veränderten Zellen automatisch in eine separate Tabelle filtern. Hat jemand eine Idee?

Hoffe es ist verständlich erklärt. Hat jemand eine Idee? Freue mich schon jetzt auf Antwort :-)!

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,

anbei die Prozedur.

Komischerweise funktioniert es bei Zellhintergrund ROT perfekt (manuelle Änderung der Hintergrundfarbe), bei bedingter Formatierung klappt es leider nicht.

Frag mich nicht warum, obwohl ich mit Interior.ColorIndex = 3 richtig abgefragt habe,
wie ich zumindest meine.

Option Explicit

Sub ZeilenKopieren()
   Dim wsQuelle As Worksheet, wsZiel As Worksheet
   Dim Bereich As Range
   Dim Startzeile As Byte, Endzeile&, Zeile&
   Dim Startspalte As Byte, Endspalte As Byte, Spalte As Byte
   Set wsQuelle = Worksheets("Tabelle1")
   Set wsZiel = Worksheets("Tabelle2")
   Set Bereich = wsQuelle.UsedRange
   Startzeile = 1
   Endzeile = Bereich.Rows.Count
   Startspalte = 1
   Endspalte = Bereich.Columns.Count
   Application.ScreenUpdating = False

   With wsZiel
      .Activate
      .UsedRange.Clear
      .Cells(1, 1).Activate
   End With

   wsQuelle.Activate

   For Zeile = Startzeile To Endzeile
      For Spalte = Startspalte To Endspalte
         If Cells(Zeile, Spalte).Interior.ColorIndex = 3 Then
            Rows(Zeile).EntireRow.Copy
               With wsZiel
                  .Activate
                  .Paste
                  .Application.CutCopyMode = False
               End With
            ActiveCell.Offset(1, 0).Activate
            wsQuelle.Activate
            Exit For
         End If
      Next Spalte
   Next Zeile

   Application.ScreenUpdating = True
End Sub

Code eingefügt mit Syntaxhighlighter 2.1

Ciao Mike

Beliebteste Forumthreads (12 Monate)

Zeilen aus Datenbank in neue Tabelle filtern

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

315 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zeilen aus Datenbank in neue Tabelle filtern

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

315 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread