Ich möchte aus Tabelle1 und den Zellen A1 bis A500, alle Zahlen auslesen und in C1 bis C500 schreiben lassen, die eine gelbe Hintergrundfarbe haben.
Kann mir bitte jemand dabei behilflich sein?
Danke schon mal
Gruß Josef
Sub GelbeNachSpalte()
'Überträgt Werte aus Zellen mit Farbe in Quellspalte in die Zielspalte
Dim wks As Worksheet, SpalteQ As Integer, SpalteZ As Integer
Dim Farbe As Integer, Zeile1 As Long, Zeile2 As Long
Set wks = Worksheets("Tabelle1")
Farbe = 6 'gelb - Hintergrundfarbe der gesuchten Zellen
Zeile1 = 1
Zeile2 = 500
SpalteQ = 1 'Spalte A - zu durchsuchende Spalte
SpalteZ = 3 'Spalte C - Zielspalte für gefundene Zellen
For Zeile1 = Zeile1 To Zeile2
If wks.Cells(Zeile1, SpalteQ).Interior.ColorIndex = Farbe Then
wks.Cells(Zeile1, SpalteZ).Value = wks.Cells(Zeile1, SpalteQ).Value
End If
Next Zeile1
End Sub
Gruß
Franz
Sub GelbeNachSpalte()
'Überträgt Werte aus Zellen mit Farbe in Quellspalte in die Zielspalte
Dim wks As Worksheet, wks2 As Worksheet, SpalteQ As Integer
Dim Farbe As Integer, Zeile1 As Long, Zeile2 As Long, ZeileZiel As Long
Set wks = Worksheets("Tabelle1")
Set wks2 = Worksheets("Tabelle2")
Farbe = 6 'gelb - Hintergrundfarbe der gesuchten Zellen
Zeile1 = 1
Zeile2 = 500
SpalteQ = 1 'Spalte A - zu durchsuchende Spalte
ZeileZiel = 2 '1. Zeile für Daten in Zieltabelle
'oder auch wie in nächster Zeile nächste freie Zeile in Zieltabelle Spalte A
' ZeileZiel = wks2.Cells(wks2.Rows.Count, 1).End(xlUp).Row + 1
For Zeile1 = Zeile1 To Zeile2
If wks.Cells(Zeile1, SpalteQ).Interior.ColorIndex = Farbe Then
'Nur Werte von Tabelle 1 nach Tabelle 2 übertragen
wks2.Cells(ZeileZiel, SpalteZiel).Range("A1:K1").Value = _
wks.Cells(Zeile1, 1).Range("A1:K1").Value
' oder Zellen komplett (Formeln, Werte + Formate) von Tabelle 1 nach Tabelle 2 _
kopieren
wks.Cells(Zeile1, 1).Range("A1:K1").Copy _
Destination:=wks2.Cells(ZeileZiel, 1).Range("A1:K1")
ZeileZiel = ZeileZiel + 1
End If
Next Zeile1
End Sub