nach Wert einfügen : wert kopieren

Hallo miteinander,
irgendwie hängt sich das Makro immer auf und ich finde keine Lösung.
Was ich gerne hätte:
In der Beispieldatei sollte bei einem Doppelklick auf ein entsprechendes Datum die Zeilenwerte in die Tabelle 3 kopiert werden.
Das klappt ja auch.
Aber nun wollte ich, dass eben diese Werte, die in der Tabelle3 eingefügt worden sind gleichzeitig in die
Spalte G = Wert von Spalte A2;
in Spalte H = Wert von Spalte B2
und in Spalte I = Wert der Spalte D2
eingefügt werden und zwar immer untereinander nach dem letzten eingegeben Wert, sodass eine kleine Liste entsteht.
Irgendwie hänge ich mich im Makro auf ...
Vielleicht hat jemand die "helfende Hand" ;-)
Danke schon mal
Wolfgang
Hier die Beispieldatei : https://www.herber.de/bbs/user/101870.xlsm

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim Z As Long, wohin As Long Dim adress As String Z = Target.Row adress = " vom " & Cells(Z, 1) adress = InputBox("Welche Kurswerte werden in die Tabelle 3 kopiert?", "D A T E N", adress) If Len(adress) Then With Sheets("Tabelle3") .Range("a2") = Cells(Z, 1) .Range("b2") = Cells(Z, 2) .Range("d2") = Cells(Z, 3) .Range("c2") = Cells(Z, 4) wohin = .Range("g" & .Rows.Count).End(xlUp).Row + 1 .Range("g" & wohin) = Cells(Z, 1) .Range("h" & wohin) = Cells(Z, 2) .Range("i" & wohin) = Cells(Z, 3) End With End If Cancel = True ' Sheets("Tabelle3").Select ? ' Call Makro3 'Sheets("Tabelle1").Select End Sub

Hallo Wolfgang,
so?

' **********************************************************************
' Modul: Tabelle1  Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim lngL1 As Long, lngL2 As Long

If Not Intersect(Target, Range("A:D")) Is Nothing Then
  If Target.Row > 3 Then
    Cancel = True
    With Sheets("Tabelle3")
      lngL1 = Application.Max(2, .Cells(.Rows.Count, 1).End(xlUp).Row + 1)
      lngL2 = Application.Max(2, .Cells(.Rows.Count, 7).End(xlUp).Row + 1)
      .Cells(lngL1, 1).Resize(1, 4) = Range(Cells(Target.Row, 1), Cells(Target.Row, 4)).Value
      .Cells(lngL2, 7).Resize(1, 2) = Range(Cells(Target.Row, 1), Cells(Target.Row, 2)).Value
      .Cells(lngL2, 9) = Cells(Target.Row, 4).Value
    End With
  End If
End If
End Sub

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

nach Wert einfügen : wert kopieren

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

nach Wert einfügen : wert kopieren

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread