PasteSpecial Paste:=xlPasteValues

[StefanB]

Hallo,

ich würde gern in dem Code:

Code:

Sub CommandButtonAblegen_Click()
If Not Intersect(Worksheets("Projekte").ListObjects(1).DataBodyRange, ActiveCell) Is Nothing Then
  With Worksheets("Ablage").ListObjects(1)
    .ListRows.Add , True
    Worksheets("Projekte").Cells(ActiveCell.Row, 3).Resize(1, 122).Copy .DataBodyRange(.ListRows.Count, 1)
    Selection.Delete Shift:=xlUp
  End With
End If
End Sub

der Dank Eurer Hilfe nun auch funktioniert, die Zeile: PasteSpecial Paste:=xlPasteValues (vllt muss der auch angepasst werden, aber ich denke Ihr wisst auf was ich hinaus möchte) einfügen. Ich habe schon alles probiert, aber i-wie klappt das nicht wirklich. Wer kann mich an dieser Stelle unterstützen?

[snb]

Code:

Sub M_snb()
   If Not ActiveCell.ListObject Is Nothing Then Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 3) = ActiveCell.ListObject.ListRows(ActiveCell.Row-1).Range.Value
End Sub

[StefanB]

Hallo snb,

sorry für meine späte Reaktion auf Deine Antwort...  
Eine kurze Frage habe ich noch. Der Code funktioniert i-wie nicht ganz richtig. Ich vermute der rotmarkierte Bereich ist falsch. Die entsprechende Zeile wird zwar kopiert und aus der Tabelle1 ausgeschnitten, aber Sie wird nicht in die Tabelle2 eingefügt. Es wird mir aber auch keine Fehlermeldung angezeigt. Nur wenn ich die rote Zahl ändere, erhalte ich den Fehler (9). Was müsste wo und vor allem warum geändert werden?


>>If Not ActiveCell.ListObject Is Nothing Then Tabelle2.Cells(Rows.Count, 3).End(xlUp).Offset(1).Resize(, 122) = ActiveCell.ListObject.ListRows(ActiveCell.Row - 3).Range.Value<<
>>Selection.Delete Shift:=xlUp<<
>>End Sub<<

[StefanB]

Ich hab´s! Worksheets(2)

Code:

   If Not ActiveCell.ListObject Is Nothing Then Worksheets(2).Cells(Rows.Count, 3).End(xlUp).Offset(1).Resize(, 122) = ActiveCell.ListObject.ListRows(ActiveCell.Row - 3).Range.Value
   Selection.Delete Shift:=xlUp

Dank Ralfs ( @RPP63 ) Eintrag: https://www.clever-excel-forum.de/thread...age-2.html

Nice WE