Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zellen mit roter Schrift in anderes Blatt kopieren

Zellen mit roter Schrift in anderes Blatt kopieren
01.01.2018 18:56:33
Burghard
Hallo,
ein gutes neues Jahr wünsche ich!
Mein aktuelles Problem: Ich kriege es nicht hin. Ich habe in einer Tabelle "Daten" mit den Spalten A:H verstreut Zeilen, die im Bereich D:H (in der jeweiligen Zeile) eine rote Schriftfarbe haben. Ich möchte aus der Tabelle "Daten" die Zeilen, die im Bereich D bis H eine rote Schrift aufweisen, in ein Tabellenblatt "Tabelle1" kopieren. Allerdings eben nicht die ganze Zeile, sondern nur den Bereich D:H aus der Tabelle "Daten". Die gefundenen Zeilen (Bereich D:H) sollen untereinander in das Tabellenblatt "Tabelle1" beginnend ab Zeile 2 in die Spalten A:E kopiert werden.
Hilfe wäre nett.
Grüße
Burghard

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zellen mit roter Schrift in anderes Blatt kopieren
01.01.2018 19:49:14
Piet
Hallo Burghard
zuerst mal ein frohes, erfolgreiches neues Jahr 2018 ....
Für die Aufgabe einfach das kleine Makro in ein Modulblatt kopieren, einen normalen Button anlegen
(kein AktiveX Element!!), dem Button das Makro zuweisen, Fertig!! - Eine Kleinigkeit noch:
Es gibt zwei Befehle: - einen von beiden bitte löschen!! - Kannst du selbst entscheiden!!
Tb1.Cells(z, 1).PasteSpecial xlPasteAll - der kopiert alles, auch die Schriftfarbe
Tb1.Cells(z, 1).PasteSpecial xlPasteValues - der kopiert nur die Werte, keine Formate oder Schrift!!
mfg Piet
Sub Daten_auflisten()
Dim j As Long, lzDt As Long
Dim Tb1 As Worksheet, z As Long
Set Tb1 = Worksheets("Tabelle1")
z = 2  '1.Zeile in Tabelle1
With Worksheets("Daten")
'LastZell in Daten suchen
lzDt = .Cells(Rows.Count, 1).End(xlUp).Row
'Schleife für alle Daten durchsuchen
For j = 1 To lzDt
If .Cells(j, 4).Resize(1, 5).Font.ColorIndex = 1 Then
Else  'rote Schriftfarbe in Zelle
.Cells(j, 4).Resize(1, 5).Copy
Tb1.Cells(z, 1).PasteSpecial xlPasteValues   'kopiert nur Werte
Tb1.Cells(z, 1).PasteSpecial xlPasteAll      'kopert auch Schriftfarbe
z = z + 1
End If
Next j
Application.CutCopyMode = False
End With
End Sub

Anzeige
AW: Zellen mit roter Schrift in anderes Blatt kopieren
01.01.2018 20:09:37
Hajo_Zi
Hallo Burghard,
beachte bei diesem Code, es wird nicht geprüft ob alle Zellen in dem Bereich die Schriftfarbe Rot haben.
Das kannst Du nur entscheiden ob das wichtig ist.
Gruß Hajo
AW: Zellen mit roter Schrift in anderes Blatt kopieren
01.01.2018 22:27:08
Burghard
Hallo Piet,
vielen Dank für Deinen Lösungsansatz. Leider funktioniert das Ganze nicht so wie gewünscht. Ich lade mal eine Beispieldatei hoch (hätte ich gleich machen sollen). Im Tabellenblatt "Gewünscht" habe ich das Ergebnis aufgeführt, wie die Daten vom Tabellenblatt "Daten" in das Tabellenblatt "Tabelle1" per VBA selektiert und kopiert werden sollen.
https://www.herber.de/bbs/user/118608.xls
Grüße
Burghard
Anzeige
AW: Zellen mit roter Schrift in anderes Blatt kopieren
01.01.2018 19:59:07
Hajo_Zi
Hallo Burghard,
Option Explicit
Sub Farbe_Rot()
Dim LoLetzte1 As Long
Dim LoLetzte2 As Long
Dim LoI As Long
Dim LoJ As Long
Dim BoFarbe As Boolean
With Worksheets("Daten")
LoLetzte1 = Worksheets("Tabelle1").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
LoLetzte2 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
For LoI = 1 To LoLetzte2
BoFarbe = False
For LoJ = 4 To 8
If Cells(LoI, LoJ).Font.Color  255 Then
BoFarbe = True
Exit For
End If
Next LoJ
If BoFarbe = False Then
.Range(.Cells(LoI, 4), Cells(LoI, 8)).Copy Worksheets("Tabelle1").Cells( _
LoLetzte1, 1)
LoLetzte1 = LoLetzte1 + 1
End If
Next LoI
End With
End Sub

Ich gebe keinen Dank für eine Rückmeldung, da ich durch solche Beiträge nicht meine Beitragszahl erhöhen muss.
Also ich schreibe keine Beiträge mit dem Betreff "Gerne u. Danke für die Rückmeldung....."
Rückmeldung ist ja in der Heutigen Zeit nicht üblich und die wenigen die eine Rückmeldung geben,
mögen mir das verzeihen, das kein Danke für eine Rückmeldung kommt.
Beiträge von Werner, Luc, robert und folgende lese ich nicht.
Anzeige
AW: Zellen mit roter Schrift in anderes Blatt kopieren
01.01.2018 22:28:06
Burghard
Hallo Hajo,
vielen Dank für Deinen Lösungsansatz. Leider funktioniert das Ganze nicht so wie gewünscht. Ich lade mal eine Beispieldatei hoch (hätte ich gleich machen sollen). Im Tabellenblatt "Gewünscht" habe ich das Ergebnis aufgeführt, wie die Daten vom Tabellenblatt "Daten" in das Tabellenblatt "Tabelle1" per VBA selektiert und kopiert werden sollen.
https://www.herber.de/bbs/user/118608.xls
Grüße
Burghard
AW: Zellen mit roter Schrift in anderes Blatt kopieren
02.01.2018 06:29:41
Werner
Hallo Burghard,
hab mal das Makoro von Piet an deine Verhältnisse angepasst.
Sub Daten_auflisten()
Dim j As Long, lzDt As Long
Dim Tb1 As Worksheet, z As Long
Set Tb1 = Worksheets("Tabelle1")
z = 2  '1.Zeile in Tabelle1
Application.ScreenUpdating = False
With Worksheets("Daten")
'LastZell in Daten suchen
lzDt = .Cells(Rows.Count, 4).End(xlUp).Row
'Schleife für alle Daten durchsuchen
For j = 1 To lzDt
If .Cells(j, 4).Font.Color = 255 Then
.Cells(j, 4).Resize(1, 5).Copy
Tb1.Cells(z, 1).PasteSpecial xlPasteAll      'kopiert auch Schriftfarbe
z = z + 1
End If
Next j
Application.CutCopyMode = False
End With
Application.ScreenUpdating = True
End Sub
Ich habe ja keine Ahnung wie lange deine Tabelle werden kann. Je nach Größe wäre das Kopieren in einer Schleife dann schon ziemlich zäh. Da gäbe es dann noch die Möglichkeit die Tabelle mit dem Autofilter nach Farbe zu filtern und dann das Filterergebnis in einem Rutsch ins Zielblatt zu kopieren.
Gruß Werner
Anzeige
AW: Zellen mit roter Schrift in anderes Blatt kopieren
02.01.2018 08:41:05
Burghard
Ein gutes neues Jahr, Werner!
Deine umgearbeitete Lösung passt prima! Danke!
Grüße
Burghard
Danke für die Rückmeldung aber...
02.01.2018 08:45:40
Werner
Hallo Burghard,
...der Dank gebührt dann wohl eher Piet, trotzdem von mir ein Danke für die Rückmeldung.
Gruß Werner
AW: Zellen mit roter Schrift in anderes Blatt kopieren
02.01.2018 06:32:30
Hajo_Zi
Hallo Burghard,
man sollte Zeilenumbrüche "_" die das Forum einfügt entfernen.
Ich habe den Code jetzt anders formatiert das keine mehr eingefügt werden.
Kleinere Fehler habe ich beseitigt und das kopieren der Titelzeile auch eingefügt.
Sub Farbe_Rot()
Dim LoLetzte1 As Long
Dim LoLetzte2 As Long
Dim LoI As Long
Dim LoJ As Long
Dim BoFarbe As Boolean
With Worksheets("Daten")
LoLetzte1 = 1
LoLetzte2 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
.Range(.Cells(1, 4), .Cells(1, 8)).Copy _
Worksheets("Tabelle1").Cells(LoLetzte1, 1)
LoLetzte1 = LoLetzte1 + 1
For LoI = 1 To LoLetzte2
BoFarbe = False
For LoJ = 4 To 8
If .Cells(LoI, LoJ).Font.Color  255 Then
BoFarbe = True
Exit For
End If
Next LoJ
If BoFarbe = False Then
.Range(.Cells(LoI, 4), .Cells(LoI, 8)).Copy _
Worksheets("Tabelle1").Cells(LoLetzte1, 1)
LoLetzte1 = LoLetzte1 + 1
End If
Next LoI
End With
Gruß Hajo
Anzeige
AW: Zellen mit roter Schrift in anderes Blatt kopieren
02.01.2018 08:42:24
Burghard
Hallo Hajo,
danke für die überarbeitete Lösung. Klappt!
Grüße
Burghard

335 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige