Zeile über activer Zeile kopieren und mehrmals einfügen

Hallo,

Ich würde gern über ein Userform folgendes ablaufen lassen.

Im Sheet"Bearbeiten" die Zeile über der activen Zeile den Bereich von B-L kopieren, diesen dann in Abhängigkeit der Zahl in der TextBox1051
x mal also auch mehrmals darunter einfügen.

wenn in "A" in der activen Zeile noch keine Zahl steht- soll dort fortlaufend nacheinander zwei Zahlen untereinander eingetragen werden,

folgendes geht bereits:

Das macht das Makro

Sub Letzte_Doppelzeile_Wiederholt_eintragen()

     

      With ActiveCell

      If .Row > 2 Then

        Cells(.Row - 2, 2).Resize(2, 11).Copy Cells(.Row, 2)

      End If

    End With

    

     

      'nun die Zahl in Zeile "A"

     With Cells(ActiveCell.Row, 1).Offset(1, 0).Resize(3, 1)

    .FormulaR1C1 = "=R[-1]C+1"

    .Formula = .Value

End With

            

   With Cells(ActiveCell.Row + 1, 2).Value 'hier eine zeile tiefer

   

   ActiveCell.Offset(2).Select

     

 End With

   

 End Sub

Kopieren der letzten 2 Zeilen und anfügen unten darunter in Abhängigkeit der gewünschten Anzahl in TextBox1050

Private Sub CommandButton20142_Click()

'übertrage die letzten Doppelzeilen x mal

        Dim x

                

                If IsNumeric(UserForm100.TextBox1050.Text) Then

                For x = 1 To CLng(UserForm100.TextBox1050)

                    Call Letzte_Doppelzeile_Wiederholt_eintragen

                Next

            Else

                MsgBox "Keine Anzahl gewählt"

            End If

            

                UserForm100.TextBox1050 = 1

            

           With Cells(ActiveCell.Row, 1).Offset(1, 0).Resize(3, 1)

    .FormulaR1C1 = "=R[-1]C+1"

    .Formula = .Value

     End With

End Sub

Dazu fehlt mir der Code.

https://www.herber.de/bbs/user/162946.xlsm

Vieleicht muss es auch ganz anders geschrieben werden.

Gruß Andreas

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub CommandButton20142_Click() 'übertrage die letzten Doppelzeilen x mal Dim x If IsNumeric(UserForm100.TextBox1050.Text) Then Application.EnableEvents = False dopp_zeile_anhängen UserForm100.TextBox1050 Application.EnableEvents = True Else MsgBox "Keine Anzahl gewählt" End If UserForm100.TextBox1050 = 1 End Sub

Sub dopp_zeile_anhängen(Wdrholung As Single) Dim lz As Single Dim i As Single Dim ber As Range lz = Cells(2, "B").End(xlDown).Row Set ber = Cells(lz - 1, 2).Resize(2, 11) For i = 1 To Wdrholung ber.Copy Cells(lz + 1, "B") lz = Cells(2, "B").End(xlDown).Row 'neu belegen Next i With Range(Cells(ber.Row, "A"), Cells(lz, "A")) .FormulaR1C1 = "=R[-1]C+1" .Formula = .Value End With End Sub

Danke, MCO,

Das läuft natürlich richtig gut. Vor allem das Ausfüllen der Spalte "A" mit fortlaufender Nummerierung läuft so besser ab.

Um das ganze noch funktioneller zu machen- wäre es von Vorteil- wenn

beim Nummerieren in "A" immer eine Zeile unter der eben eingefügten eine fortlaufende Nummer erhält, und in der Spalte "C" aktiv werden.

"Z.B ich bin in Zeile 66 und habe 2x letzte Doppelzeile " gewählt, dann die Zeile 64 und 65 nach 66 und 67 und nach 68 und 69 duplizieren- was es bereits schon so tut ...
jetzt noch in "A" die "70" eintragen. und in der 70 in Spalte C aktiv werden.

das aktiv werden würde ich mit

With Cells(ActiveCell.Row + 1, 2).Value 'hier eine zeile tiefer

   

        ActiveCell.Offset(2).Select

     

    End With

aber es heftet sich noch nicht ganz an die letzte Einfügestelle

Was müsste ich jetzt noch abändern, wenn ein zweiter CommandButton20143 mit TextBox1051 im UserForm100

das gleiche machen soll, jedoch nur für die darüber liegende Zeile (Einzelzeile).

"übertrage die letzte Zeile x mal "

"Z.B ich bin in Zeile 90 und habe 3x letzte Zeile " gewählt, dann die Zeile 89 kopieren und diese nach 90; 91 und 92 duplizieren-
jetzt noch in "A" die "93" eintragen. und in der 93 in Spalte C aktiv wieder werden.

Habe noch mal eine Musterdatei angehangen.

https://www.herber.de/bbs/user/162967.xlsm

Danke schon mal für die Hilfe.

Gruß Andreas

Sub dopp_zeile_anhängen(Wdrholung As Single) Dim lz As Single Dim i As Single Dim ber As Range lz = Cells(2, "B").End(xlDown).Row Set ber = Cells(lz - 1, 2).Resize(2, 11) For i = 1 To Wdrholung ber.Copy Cells(lz + 1, "B") lz = Cells(2, "B").End(xlDown).Row 'neu belegen Next i With Range(Cells(ber.Row, "A"), Cells(lz + 1, "A")) .FormulaR1C1 = "=R[-1]C+1" .Formula = .Value End With End Sub

Private Sub CommandButton20143_Click() 'übertrage die letzte Zeile x mal Dim x If IsNumeric(UserForm100.TextBox1051.Text) Then Application.EnableEvents = False letzte_zeile_anhängen UserForm100.TextBox1051 Application.EnableEvents = True Else MsgBox "Keine Anzahl gewählt" End If UserForm100.TextBox1051 = 1 End Sub

Sub letzte_zeile_anhängen(Wdrholung As Single) Dim lz As Single Dim i As Single Dim ber As Range lz = ActiveCell.Row Set ber = Cells(lz - 1, 2).Resize(1, 11) For i = 1 To Wdrholung ber.Copy Cells(lz + i, "B") Next i With Range(Cells(ber.Row, "A"), Cells(lz + i, "A")) .FormulaR1C1 = "=R[-1]C+1" .Formula = .Value End With End Sub

Beliebteste Forumthreads (12 Monate)

Zeile über activer Zeile kopieren und mehrmals einfügen

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

311 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zeile über activer Zeile kopieren und mehrmals einfügen

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

311 Forumthreads zu ähnlichen Themen

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