Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 00:20:14
Bestimmte Spalten als xls exportieren per Makro
23.04.2024 22:08:10
Auflisten in Spalte VBA
23.04.2024 21:33:46
Nur farbige/nicht farbige Zellen markieren
23.04.2024 21:29:56
Bestimmte Zellen auf andere Arbeitsblätter kopieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1240to1244
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1240to1244
1240to1244
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Inhalte mit Farbe übertragen

Inhalte mit Farbe übertragen
Karsten
Hallo,
in u.st. Beispiel sollen Inhalte mit Colorindex 3 in Tabelle 2 kopiert werden. Es funktioniert aber nur, wenn in der Zelle schon etwas in anderer Farbe steht. Vielleicht kann jemand den Befehl entsprechend abändern. Ich hab ihn irgendwann mal von jemand bekommen.
https://www.herber.de/bbs/user/77842.xls
Besten Dank für eure Hilfe.
Gruß
Karsten

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Inhalte mit Farbe übertragen
07.12.2011 07:30:17
fcs
Hallo Karsten,
so sollte es funktionieren.
Gruß
Franz 
Sub a()
Dim Erg As String
Dim Erg1 As String
Dim sp As Long
Dim ze As Long
Dim sh1 As Worksheet, sh2 As Worksheet
Dim Zelle As Range
Dim i As Long
Set sh1 = Sheets("Tabelle1")
Set sh2 = Sheets("Tabelle2")
sh2.Cells.Clear
For sp = 4 To sh1.UsedRange.Columns.Count
sh2.Cells(sp, 1).Value = sh1.Cells(1, sp)
Erg = ""
For Each Zelle In Range(sh1.Cells(2, sp), sh1.Cells(Rows.Count, sp).End(xlUp))
'If IsNull(Zelle.Font.ColorIndex) Then
Erg1 = ""
For i = 1 To Len(Zelle.Value)
If Zelle.Characters(i, 1).Font.ColorIndex = 3 Then
Erg1 = Erg1 & Mid(Zelle.Value, i, 1)
End If
Next
If Erg1  "" Then Erg = Erg & Erg1 & ", "
'End If
Next
If Erg  "" Then sh2.Cells(sp, 2).Value = Left(Erg, Len(Erg) - 2)
Next
Sheets("Tabelle2").Select
End Sub

Anzeige
AW: Inhalte mit Farbe übertragen
07.12.2011 08:28:12
Karsten
Hallo Franz,
danke.
Gruß
Karsten

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige