Ereignismakro: Werte aus Tab1 in Tabe2 kopieren

Hallo Forumsbesucher,
ich hoffe sehr, dass ich bei den VBA-Spezialisten Hilfe bei der Umsetzung der nachfolgenden Aufgabe erhalten kann:
In der Tabelle1 befinden sich in der Zeile 18 Daten in den Zellen C18, sowie K18:P18. Der aus diesen Zellen resultierende Datensatz ändert sich immer, wenn ich den Zelle M18 eine neue Eingabe vornehme.
Ich würde nun gerne erreichen, dass nach Änderung des Zellwerte in M18, die dann in den Zellen C18, K18:P18 stehenden Werte in die Tabelle2 in die erste freie Zeile, beginnend ab Zeile 5 kopiert wird, und zwar der Wert aus C18 in die Spalte A, die Werte aus K18:P18 in den Bereich der Spalten B:G der Tabelle2.
Somit würde beim erstmaligen Ausführen des Makros die Werte aus Tabelle1 in die Zeile 5 der Tabelle2 kopiert, danach in die Zeile 6, anschließend in die Zeile7 usw.
Dank allen, die mir Hilfe anbieten.
mfg
Fritz

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim zz As Long If Intersect(Target, Cells(18, 13)) Is Nothing Then Exit Sub With Sheets("Tabelle2") zz = Application.Max(.Cells(Rows.Count, 1).End(xlUp).Row + 1, 5) .Cells(zz, 1) = Cells(18, 3) .Range(.Cells(zz, 2), .Cells(zz, 7)) = Range(Cells(18, 11), Cells(18, 16)).Value End With End Sub

Hallo Erich,
vielen Dank, dass Du mir erneut Deine kompetente Hilfe anbietest.
Dein Code funktioniert wie gewünscht.
Ich habe nur das Problem, dass ich ihn in einer Tabelle benötige, in der sich schon Makros (im Tabellenmodul) befinden. Übrigens Code, den Du mir vor wenigen Tagen in diesem Forum (für eine andere Tabelle) zur Verfügung gestellt hast und den ich mir für die aktuelle Tabelle abgeändert habe. Er läuft soweit in dieser Tabelle auch - mit nachfolgend beschriebener Einschränkung - wie gewünscht. Ich wollte eigentlich, dass nunmehr, die erfasste Zeit immer in die Zelle M18 kopiert wird. Mein Code beginnt mit M18 und fügt weitere Werte in die darunterliegende Zeile der Spalte M ein. Dies wollte ich ändern. Und in eben diese Tabelle sollte dein obiger Code zusätzlich laufen, aber das funktioniert nicht.
Könntest Du mir dabei behilflich sein? Wäre toll, wenn ich das zum laufen bekäme!
Schönen Gruß
Fritz
Hier der bisher sich im Tabellenmodul der Tabelle1 befindende Code:
Option Explicit
Dim lngZ As Long, sngT As Single

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Cells(1, 3) = 1 And sngT = 0 Then
sngT = Timer
ElseIf Cells(1, 3) = 2 And sngT > 0 Then                 ' C ist 3. Spalte
If lngZ < 18 Then lngZ = 18                           ' ab Zeile 18
Cells(lngZ, 13) = Application.Round(Timer - sngT, 1)   ' M ist 13. Spalte
lngZ = lngZ + 1
sngT = 0
ElseIf Target.Address = "$J$2" Then Range("J3").ClearContents
End If
Application.EnableEvents = True
End Sub

Sub init()
lngZ = 18 ' ab Zeile 18
sngT = 0
Application.EnableEvents = False
Range(Cells(18, 13), Cells(Rows.Count, 13)).ClearContents 'Spalte M ab Zeile 18 leeren
Application.EnableEvents = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range) Dim zz As Long Application.EnableEvents = False If Cells(1, 3) = 1 And sngT = 0 Then sngT = Timer ElseIf Cells(1, 3) = 2 And sngT > 0 Then ' C ist 3. Spalte If lngZ < 18 Then lngZ = 18 ' ab Zeile 18 Cells(lngZ, 13) = Application.Round(Timer - sngT, 1) ' M ist 13. Spalte With Sheets("Tabelle2") zz = Application.Max(.Cells(Rows.Count, 1).End(xlUp).Row + 1, 5) .Cells(zz, 1) = Cells(lngZ, 3) .Range(.Cells(zz, 2), .Cells(zz, 7)) = Range(Cells(lngZ, 11), Cells(lngZ, 16)).Value End With lngZ = lngZ + 1 sngT = 0 ElseIf Target.Address = "$J$2" Then Range("J3").ClearContents End If Application.EnableEvents = True End Sub Sub init() lngZ = 18 ' ab Zeile 18 sngT = 0 Application.EnableEvents = False Range(Cells(18, 13), Cells(Rows.Count, 13)).ClearContents 'Spalte M ab Zeile 18 leeren Application.EnableEvents = True End Sub

Option Explicit Dim sngT As Single Private Sub Worksheet_Change(ByVal Target As Range) Dim zz As Long Application.EnableEvents = False If Cells(1, 3) = 1 And sngT = 0 Then sngT = Timer ElseIf Cells(1, 3) = 2 And sngT > 0 Then ' C ist 3. Spalte Cells(18, 13) = Application.Round(Timer - sngT, 1) ' M18 ist cells(18,13) With Sheets("Tabelle2") zz = Application.Max(.Cells(Rows.Count, 1).End(xlUp).Row + 1, 5) .Cells(zz, 1) = Cells(18, 3) .Range(.Cells(zz, 2), .Cells(zz, 7)) = Range(Cells(18, 11), Cells(18, 16)).Value End With sngT = 0 ElseIf Target.Address = "$J$2" Then Range("J3").ClearContents End If Application.EnableEvents = True End Sub Sub init() sngT = 0 End Sub

Beliebteste Forumthreads (12 Monate)

Ereignismakro: Werte aus Tab1 in Tabe2 kopieren

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread