Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1092to1096
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
Inhaltsverzeichnis

Special Selection

Special Selection
Carsten
Hallo zusammen,
leider ist VBA und Excel aus meinem Studium schon in Vergessenheit geraten und ich brauche Eure Hilfe:
Ziel:
Einen Bereich mit der Maus markieren und dann auf einen Button klicken, damit dann nur noch alle farbigen Felder markiert sind.
Alternative kann statt der Rückgabe als Markierung der Bereich in ein zweites Excel-Sheet kopiert werden.
Da der Bereich nicht rechteckig sein wird, muss wahrscheinlich eh jede zelle direkt kopiert werden, da select nur mit rechteckigen bereichen arbeiten kann.
Vielen Dank im Voraus
Gruß Carsten

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

Betreff
Benutzer
Anzeige
AW: Special Selection
30.07.2009 10:33:15
Wolli
Hallo Carsten, so müsste das gehen (Das ist Deine Alternative). Man könnte natürlich auch einen Multi-Select zusammenkrampfen, aber ich denke, so ist es eleganter.
Sub test()
Dim Zielbereich As Range, Kopierzelle As Range
'Obere linke Zelle des Zielbereichs festlegen
Set Zielbereich = Sheets("Tabelle2").Range("B7")
'Jede Zelle in der Markierung durchnudeln
For Each Kopierzelle In Selection.Cells
'Wenn sie eine Färbung hat, kopieren.
'Das Kopierziel wird anhand der Position
'innerhalb der Markierung ermittelt
If Kopierzelle.Interior.ColorIndex  xlNone Then _
Kopierzelle.Copy Destination:=Zielbereich.Offset _
(Kopierzelle.Row - Selection.Row, _
Kopierzelle.Column - Selection.Column)
Next Kopierzelle
End Sub
Gruß, Wolli
Anzeige
AW: Special Selection
30.07.2009 10:47:12
hary
Hallo Carsten
meinst Du so?
Beispielmappe
https://www.herber.de/bbs/user/63530.xls
der Code

Sub n()
Dim rng As Range
Dim c As Range
Set rng = Selection
For Each c In rng
If c.Interior.ColorIndex  xlNone Then
c.Copy Sheets("Tabelle2").Cells(c.Row, c.Column)
End If
Next c
End Sub

Gruss hary
AW: Special Selection
30.07.2009 11:37:15
Carsten
vielen dank an beide
das ging ja rasend schnell

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige