Frage zu einem Programmtext! Mit Code

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) If Target.Column = 1 And Target.Row > 8 Then If Target.Cells.Count 2 Then Exit Sub If Target.Offset(1, 0).MergeArea.Address Target.Offset(1, 0).Address Then Exit Sub Target.Resize(2, 27).Copy Destination:=Target.Offset(1, 0) Target.Offset(1, 0).Resize(2, 27).ClearContents Target.Offset(1, 0) = Target.Cells(1, 1) + 1 Target.Offset(1, 0).RowHeight = Target.Cells(1, 1).RowHeight Target.Offset(2, 0).RowHeight = Target.Cells(2, 1).RowHeight Cancel = True End If End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) With Target If .Column = 1 And .Row > 8 Then If .Cells.Count = 2 Then If .Offset(1).MergeArea.Count = 1 Then Application.ScreenUpdating = False .Resize(2, 27).Copy .Offset(1).PasteSpecial xlPasteFormats .Offset(1) = .Cells(1, 1) + 1 .Offset(1).RowHeight = .Cells(1).RowHeight .Offset(2).RowHeight = .Cells(2).RowHeight With .Offset(1, 2).Resize(2, 3) .Interior.Color = vbRed .Value = "xxx" End With .Offset(1).Select Cancel = True Application.CutCopyMode = False End If End If End If End With End Sub

Vielen Dank Rudi, leider klappt das durch den Code noch nicht so ganz, aber das kann ich ja auch nicht erwarten. Vielleicht kriegen wir das ja noch hin.
Also es sollten zwei neue Zeilen beim Rechtsklick eingefügt werden, wobei aber nur Teie des Inhalts der vorherigen Zeile übernommen werden sollen.
Ich habe mal einen Screenshot gemacht.
So sollte es aussehen:
Userbild

Durch meinen aktuellen Quelltext:


Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 1 And Target.Row > 8 Then
If Target.Cells.Count  2 Then Exit Sub
If Target.Offset(1, 0).MergeArea.Address  Target.Offset(1, 0).Address Then Exit Sub
Target.Resize(2, 27).Copy
Target.Offset(1, 0).PasteSpecial Paste:=xlPasteFormats
' Target.Resize(2, 27).Copy Destination:=Target.Offset(1, 0)
' Target.Offset(1, 0).Resize(2, 27).ClearContents
Target.Offset(1, 0) = Target.Cells(1, 1) + 1
Target.Offset(1, 0).RowHeight = Target.Cells(1, 1).RowHeight
Target.Offset(2, 0).RowHeight = Target.Cells(2, 1).RowHeight
Cancel = True
End If
End Sub

---> sieht das ganze aber noch so aus:
Userbild

Ich denke, ich habe meinen Wunsch ganz gut beschrieben, oder?
Ich wäre euch wirklich dankbar, wenn mir dabei noch jemand helfen könnte. Dann wäre ich auch erstmal durch mit meinem Programm.
Dieses Forum hat mir bisher echt super dabei geholfen! Vielen Dank an alle!

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) With Target If .Column = 1 And .Row > 8 Then If .Cells.Count = 2 Then If .Offset(1).MergeArea.Count = 1 Then Application.ScreenUpdating = False .Resize(2, 27).Copy .Offset(1).PasteSpecial xlPasteFormats .Offset(1) = .Cells(1, 1) + 1 .Offset(1).RowHeight = .Cells(1).RowHeight .Offset(2).RowHeight = .Cells(2).RowHeight .Offset(, 3).Resize(2).Copy .Offset(1, 3) With .Offset(2, 4).Resize(, 23) .Interior.Color = RGB(153, 204, 255) .Value = "NR" End With .Offset(1).Select Cancel = True Application.CutCopyMode = False End If End If End If End With End Sub

Beliebteste Forumthreads (12 Monate)

Frage zu einem Programmtext! Mit Code

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread