Clever-Excel-Forum

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? Blush

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

Hallo snb,

sorry für meine späte Reaktion auf Deine Antwort... Undecided

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<<

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

StefanB

snb

StefanB

StefanB