Per Ereignismakro Zellbereiche kopieren

Hallo VBA-Experten,
ich benötige eure Unterstützung in folgender Angelegenheit:
In einer Tabelle befinden sich in der Zeile 1 im Bereich H1:CU1 ganze Zahlen von 0 bis 30 (jede Zahl jedoch nur 1x). Mittels Gültigkeitsprüfung habe ich nun sichergestellt, dass in der Zelle G1 ebenfalls nur ganze Zahlen zwischen 0 und 30 eingegeben werden können.
Wenn ich nun in G1 eine Zahl eingebe (bzw. die darin enthaltene Zahl ändere), soll jeweils geprüft werden in welcher Spalte sich die gleiche Zahl im Bereich H1:CU1 befindet. Wird die Zahl im entsprechenden Bereich gefunden, soll immer der Bereich in der gleichen Spalte und der davorliegenden Spalte von Zeile 1 bis zur Zeile 50 in den Bereich CV1:CW50 kopiert werden.
Als Beispiel:
Wird in die Zelle G1 die Zahl 4 eingegeben und befindet sich die Zahl 4 in Zelle T1 soll der Bereich S1:T50 nach CV1:CW50 kopiert werden.
Wird die Zahl in G1 geändert, soll die Kopieraktion erneut stattfinden, so dass die Werte in CV1:CW50 dann überschrieben werden sollen.
Ich hoffe, dass ich mein Anliegen verständlich formuliert habe und danke bereits an dieser Stelle allen, die mir bei der Erstellung des Codes behilflich sein wollen.
Gruß
Fritz

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range If Target.Address(0, 0) <> "G1" Or Target.Count > 1 Then Exit Sub Set rng = ActiveSheet.Range("H1:CU1").Find( _ what:=Range("G1").Value, lookat:=xlWhole, LookIn:=xlValues) If rng Is Nothing Then Exit Sub Range(Cells(1, rng.Column - 1), Cells(50, rng.Column)).Copy Range("CV1").PasteSpecial xlPasteValues Application.CutCopyMode = False End Sub

Hallo Fritz,
das nachstehende Makro gehört in das Modul des entsprechenden Tabellenblattes.
Übrigens: Deine Problembeschreibung hat mir sehr gut gefallen und ist für mich sehr verständlich (wenn nur immer alle Problembeschreibungen dieses Niveau hätten . . .) ; eine gute Problembeschreibung ist meist auch schon die halbe Lösung!


Private Sub Worksheet_Change(ByVal Target As Range)
Dim SuBe As Range, _
s As String
If Target.Address <> "$G$1" Then Exit Sub
s = Target.Text
Set SuBe = Range("H1:CU1").Find(What:=s, _
After:=Range("CU1"), LookAt:=xlWhole)
If Not SuBe Is Nothing Then
Application.EnableEvents = False       'Ereignis AUS
Range("CV1:CW50").Value = _
Range(Cells(1, SuBe.Column - 1), Cells(50, SuBe.Column)).Value
Application.EnableEvents = True        'Ereignis EIN
Set SuBe = Nothing
Else
MsgBox "Suchbegriff '" & s & "' nicht gefunden !", 64, _
"Dezenter Hinweis für " & Application.UserName & ":"
End If
End Sub

Viel Erfolg wünscht
WernerB.
P.S.: Dieses Forum lebt auch von den Rückmeldungen der Fragesteller an die Antworter !

Beliebteste Forumthreads (12 Monate)

Per Ereignismakro Zellbereiche kopieren

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread