Wert soll automatisch in Tabelle und sol

Hallo Zusammen,
ich habe zu meinem Problem keine Lösung gefunden. Und hoffe das Ihr mir weiterhelfen könnt.
Jetzt zu meinem Problem:
Ich habe in den Zeilen A3-F3 und A4-F4 meine Eingabe für Werte, diese führe ich dann kombiniert in
den Zeilen B6 und B7 auf (dies funktioniert auch).
Nun möchte ich die Werte aus B6 und B7 in eine Tabelle einfügen können, durch beispielsweise einen Doppelklick.
B6 soll in I und der Wert aus B7 soll in H.
Wie bekomme ich es nun hin, dass diese Werte automatisch (durch Doppelklick) in die Entsprechende Spalte I/H (Tabelle) eingefügt werden und nicht verändert werden wenn sich der Wert aus B6/B7 ändert.
Ich hoffe es ist verständlich was mein Problem ist und Ihr mir weiterhelfen könnt. Danke

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Select Case Target.Address(0, 0) Case "B6" Cancel = True Range("I" & Cells(Rows.Count, "I").End(xlUp).Offset(1).Row) = Target Case "B7" Cancel = True Range("H" & Cells(Rows.Count, "H").End(xlUp).Offset(1).Row) = Target Case Else End Select End Sub

Hallo
diesen Code bitte in das Tabellenblatt für die Zellen B6/B7 kopieren. Dann sollte es klappen.
Die Werte werden immer unter den letzten eingefügt. Ich gehe davon aus das die Zeilen in Spalte H+I immer gleich lang sind, sonst muss man noch lz2 mit programmieren. (bereits vorgesehen)
Bitte im Makro noch den richtigen Namen der Tabelle2 angeben, ich habe hier "Tabelle2" gewaehlt!
mfg Piet

Dim lz1 As Long
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
'** Bitte den richtigen Tabellen Namen einsetzen!!
With Worksheets("Tabelle2")
'LastZell in Spalte H, Tabelle2 suchen
lz1 = .Cells(Rows.Count, "H").End(xlUp).Row   '** lz2 nur bei Zeienunterschied nötig!
'lz2 = .Cells(Rows.Count, "I").End(xlUp).Row
'Prüfen ob Eingabe bereits erfolgt ist?
If .Cells(lz2, "I") = ActiveSheet.Range("B6") And _
.Cells(lz2, "H") = ActiveSheet.Range("B7") Then
MsgBox "Diese Eingabe ist bereits erfolgt!": Exit Sub
End If
'Werte in 2. Tabelle gemeinsam übertragen
.Cells(lz1 + 1, "I") = ActiveSheet.Range("B6")
.Cells(lz1 + 1, "H") = ActiveSheet.Range("B7")   '** ggf. lz2 programmieren (Zeiien  _
verschoben!)
End With
End Sub

Beliebteste Forumthreads (12 Monate)

Wert soll automatisch in Tabelle und sol

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread