Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1496to1500
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

Zelle bei Markierung kopieren

Zelle bei Markierung kopieren
03.06.2016 16:52:20
detrick
Hallo,
Ich habe zwei Spalten mit Namen und Vornamen (A1:A10 und B1:B10). Ist es möglich, sobald ich eine bestimmte Zelle von den Namen oder Vornamen markiere, diese automatisch in zwei andere Zellen kopiert werden? Also wenn A1 markiert wird, soll automatisch der Text von A1 und B1 in z.B. C4 und D4 kopiert werden und sobald ich einen anderen Namen markiere soll dieser automatisch in C4 und D4 kopiert werden.
Ist dies möglich und könnte mir jemand behilflich sein?
Gruß

16
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zelle bei Markierung kopieren
03.06.2016 17:01:36
Hajo_Zi

Option Explicit                                     ' Variablendefinition erforderlich
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'* H. Ziplies                                  *
'* 03.06.20156                                    *
'* erstellt von HajoZiplies@web.de             *
'* http://Hajo-Excel.de/
Dim RaBereich As Range                          ' Variable für Bereich
Dim RaZelle As Range                            ' Variable für Zelle
Set RaBereich = Range("A1:B10")                 ' Bereich der Wirksamkeit
' noch mehr Bereiche
'Set RaBereich = Union(Range("C11:AG11 , C13:AG13, C15:AG15 , C17:AG17"), _
'    Range("C35:AE35, C37:AE37, C43:AG43, C45:AG45 , C47:AG47 , C49:AG49"), _
'    Range("C67:AF67 , C69:AF69 , C75:AG75 , C77:AG77 , C79:AG79 , C81:AG81"), _
'    Range("C99:AF99 , C101:AF101, C107:AG107 , C109:AG109 , C111:AG111"), _
'    Range("C127:AG127 , C129:AG129 , C131:AG131 , C133:AG133 , C139:AF139"), _
'    Range("C155:AG155, C157:AG157 , C159:AG159 , C161:AG161 , C163:AG163"), _
'    Range("C179:AF179 , C181:AF181, C187:AG187 , C189:AG189 , C191:AG191"))
' Zelle die in dem Bereich liegen auf die Variable schreiben
' damit werden nur noch die Zellen bearbeitet die im vorgegeben Bereich liegen
' jede Zelladresse ist einzeln angegeben
Set RaBereich = Intersect(RaBereich, Target)
If Not RaBereich Is Nothing Then
'ActiveSheet.Unprotect ("Passwort")
For Each RaZelle In RaBereich
With RaZelle
Range("C4") = Cells(Target.Row, 1)
Range("D4") = Cells(Target.Row, 2)
Exit For
End With
Next RaZelle
'ActiveSheet.protect ("Passwort")
End If
Set RaBereich = Nothing                         ' Variable leeren
End Sub
starte den VBA Editor (Alt+F11), Bild sollte zweigeteilt sein ansonsten Strg+R, Doppelklick auf Deine Datei, Doppelklick auf Deine Tabelle, Code ins rechte Fenster kopieren, VBA Editor schließen.
Das Makro wird automatisch gestartet.
Der Code wirkt nur in dieser Tabelle.

Anzeige
AW: Zelle bei Markierung kopieren
04.06.2016 11:48:16
detrick
Wow ihr seid ja super!
Eine kleine Frage hätte ich aber noch:
Ist es möglich, dass wenn ich entweder eine Zelle von "Name" oder "Vorname" markiert habe, beide gleichzeitig ihre Hintergrundfarbe ändern?
gruß

AW: Zelle bei Markierung kopieren
04.06.2016 11:53:09
Hajo_Zi
es geht ja nur um dass markieren nicht zurück
vor end With
Cells(Target.Row, 1).interior.color =255
Cells(Target.Row, 2).interior.color=255
Gruß Hajo

AW: Zelle bei Markierung kopieren
04.06.2016 12:01:17
detrick
Hallo,
zunächst danke für die schnelle Antwort.
Dein Code bezieht sich aber auf die Zelle C4 und D4, ich meinte aber die ursprüngliche Zellen A1 und B1.

Anzeige
AW: Zelle bei Markierung kopieren
04.06.2016 12:09:32
Hajo_Zi
gut dann poste den Code, dann kann vielleicht auch geholfen werden. Mein Code bezieht sich nicht auf C4 und D4.
Gruß Hajo

AW: Zelle bei Markierung kopieren
04.06.2016 13:08:08
detrick
Ah du hattest Recht, war mein Fehler.
Nur eine kleine Sache noch:
Die Hintergrundfarbe der Zelle soll nur so lange rot sein, wie sie auch markiert ist, danach soll sie wieder keine Hintergrundfarbe haben. Vielen Dank nochmals für deine super Hilfe!

AW: Zelle bei Markierung kopieren
04.06.2016 13:18:58
Hajo_Zi
lese alle meine Antworten. Ich muss mich nicht wiederholen.
Gruß Hajo

Anzeige
AW: Zelle bei Markierung kopieren
04.06.2016 12:01:29
Hajo_Zi
falls doch auch zurück?
Option Explicit                                     ' Variablendefinition erforderlich
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'* H. Ziplies                                  *
'* 03.06.2016                                    *
'* erstellt von HajoZiplies@web.de             *
'* http://Hajo-Excel.de/
Dim RaBereich As Range                          ' Variable für Bereich
Dim RaZelle As Range                            ' Variable für Zelle
Set RaBereich = Range("A1:B10")                 ' Bereich der Wirksamkeit
' noch mehr Bereiche
'Set RaBereich = Union(Range("C11:AG11 , C13:AG13, C15:AG15 , C17:AG17"), _
'    Range("C35:AE35, C37:AE37, C43:AG43, C45:AG45 , C47:AG47 , C49:AG49"), _
'    Range("C67:AF67 , C69:AF69 , C75:AG75 , C77:AG77 , C79:AG79 , C81:AG81"), _
'    Range("C99:AF99 , C101:AF101, C107:AG107 , C109:AG109 , C111:AG111"), _
'    Range("C127:AG127 , C129:AG129 , C131:AG131 , C133:AG133 , C139:AF139"), _
'    Range("C155:AG155, C157:AG157 , C159:AG159 , C161:AG161 , C163:AG163"), _
'    Range("C179:AF179 , C181:AF181, C187:AG187 , C189:AG189 , C191:AG191"))
' Zelle die in dem Bereich liegen auf die Variable schreiben
' damit werden nur noch die Zellen bearbeitet die im vorgegeben Bereich liegen
' jede Zelladresse ist einzeln angegeben
Set RaBereich = Intersect(RaBereich, Target)
Columns("A:B").Interior.ColorIndex = xlNone
If Not RaBereich Is Nothing Then
'ActiveSheet.Unprotect ("Passwort")
For Each RaZelle In RaBereich
With RaZelle
Range("C4") = Cells(Target.Row, 1)
Range("D4") = Cells(Target.Row, 2)
Cells(Target.Row, 1).Interior.Color = 255
Cells(Target.Row, 2).Interior.Color = 255
Exit For
End With
Next RaZelle
'ActiveSheet.protect ("Passwort")
End If
Set RaBereich = Nothing                         ' Variable leeren
End Sub

Gruß Hajo

Anzeige
AW: Zelle bei Markierung kopieren
03.06.2016 17:06:50
Werner
Hallo,
Rechtsklick auf den Tabellenblattreiter der Tabelle in der sich das auswirken soll - Code Anzeigen - Code rechts ins Codefenster kopieren
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 1 And Target.Row 
Gruß Werner

AW: Zelle bei Markierung kopieren
03.06.2016 17:22:53
Matthias
Hallo
Einspruch
Zitat:
Ist es möglich, sobald ich eine bestimmte Zelle von den Namen oder Vornamen markiere
Also ist:
If Target.Column = 1 nicht korrekt
Es sollte dann auf:
If Target.Column < 3 hinauslaufen ...
Da es sich um Spalte("A") oder Spalte("B") handelt!
Then ... muss dann natürlich ebenfalls angepasst werden.
Gruß Matthias

Anzeige
AW: Zelle bei Markierung kopieren
03.06.2016 17:33:32
Werner
Hallo Matthias,
dem Einspruch gebe ich statt. Wer lesen kann ist klar im Vorteil.
Das ist unter anderem der Vorteil dieses Forums, es gibt genügend Profis die mitlesen und denen das dann auffällt.
Sollte eigentlich nicht nötig sein - ich gelobe Besserung.
Gruß Werner

AW: Zelle bei Markierung kopieren
03.06.2016 18:05:30
Werner
Hallo,
aufgrund des berechtigten Einspruchs von Matthias für beide Spalten dann z.B. so:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Row 
Gruß Werner

AW: Zelle bei Markierung kopieren
03.06.2016 18:09:54
Hajo_Zi
Hallo Werner,
es reicht
elseif Target.Column = 2 Then
falls mehrere Zellen markiert werden löst es wohl einen Fehler aus?
Gruß Hajo

Anzeige
oder so ;-)
03.06.2016 18:21:29
Matthias
Hallo
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Row 
Gruß Matthias

AW: oder so ;-)
03.06.2016 18:25:56
Werner
Hallo Matthias,
wieder mal zu sehr um die Ecke gedacht. Danke für den Zaunpfahl.
Gruß Werner

bitte ... & schönes WE ;-) owT
03.06.2016 18:30:33
Matthias

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige