Zeile einfügen und Inhalt kopieren

Forumthread: Zeile einfügen und Inhalt kopieren

08.04.2019 15:08:25

Martin

Hallo Zusammen!
folgende Aufgabe:
Ich habe eine Tabelle mit mehreren Spalten, A-H.
Nun soll per Doppelklick auf eine Zelle eine Zeile direkt darunter eingefügt werden und der Inhalt(Text) der darüberliegenden Zelle A und H kopiert und eingefügt werden, die restlichen Zeilen sollen leer bleiben. Um diese Zellen aber unterscheiden zu können soll sowohl im Text bei Zelle A und H ein (2), bzw. wenn öfter kopiert ein (3),(4) usw. eingefügt werden.
Vielleicht weiß jemand eine Lösung, würde mich sehr freuen.
Gruß Martin
mein bisheriger code lautet so:


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Rows(Target.Row).Copy
Rows(Target.Row + 1).Insert Shift:=xlDown
Application.CutCopyMode = False
Cells(Target.Row + 1, Target.Column).Select
End Sub

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

AW: Zeile einfügen und Inhalt kopieren

08.04.2019 18:23:48

kathrin

AW: Zeile einfügen und Inhalt kopieren

08.04.2019 18:23:48

kathrin

Hallo Martin,
deine formulierte Aufgabe ist für mich leider nicht in allen Punkten verständlich.
Welche Zeilen (oder meisnt du Spalten?) sollen leer bleiben?
Was steht in deinen Daten. Kann man z.B. davon ausgehen, dass dort keine Klammern vorkommen? In diesem Fall hier ein Vorschlag, für das Ergänzen und Hochzählen der Versionszahlen in Spalte A.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Rows(Target.Row).Copy
Rows(Target.Row + 1).Insert Shift:=xlDown
Application.CutCopyMode = False
'Ergänze Wert der Spalte A mit (2) oder entsprechend höherer Zahl
Dim strValueA As String
strValueA = Cells(Target.Row, 1).Value
If Right(strValueA, 4) Like "*(*)" Then
Cells(Target.Row + 1, 1) = Left(strValueA, InStr(1, strValueA, "(")) & _
Val(Mid(strValueA, InStr(1, strValueA, "(") + 1,_
Len(strValueA) - InStr(1, strValueA, "(") - 1))+ 1 & ")"
Else
Cells(Target.Row + 1, 1) = strValueA & "(2)"
End If
'Falls Zeile schon dupliziert war, zähle Zähler der folgenden Zeilen hoch
Dim line As Integer
line = Target.Row + 1
While (Cells(line, 1).Value = Cells(line + 1, 1).Value)
strValueA = Cells(line, 1).Value
Cells(line + 1, 1).Value = Left(strValueA, InStr(1, strValueA, "(")) & _
Val(Mid(strValueA,InStr(1, strValueA, "(") + 1, _
Len(strValueA) - InStr(1, strValueA, "(") - 1)) + 1 & ")"
line = line + 1
Wend
Cells(Target.Row + 1, Target.Column).Select
End Sub

Beliebteste Forumthreads (12 Monate)

Zeile einfügen und Inhalt kopieren

Forumthread: Zeile einfügen und Inhalt kopieren

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread