Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: bestimmte Anzahl an Zeilen kopieren und einfügen

bestimmte Anzahl an Zeilen kopieren und einfügen
23.08.2018 14:52:48
VBA
Hallo,
ich habe folgendes Makro um eine bestimmte Zeile zu kopieren. Es wird jeweils die Zeile kopiert, in der sich die markierte Zelle befindet. Anschließend kommen 3 Abfragen, um einen bestimmten Text zu übernehmen oder zu ändern. Dies funktioniert soweit sehr gut, allerdings immer nur für eine Markierung (also auch nur für eine Zeile)
Mein Anliegen:
ich würde gerne mehrere Zellen (1 Zelle pro Zeile) markieren und das Makro geht die Anzahl der Zeilen nach und nach durch. Leider sind meine Fähigkeiten hier begrenzt. Kann mir jemand hier helfen und das Makro umbauen?
Vielen Dank
Gruß
Sub ZeileKopieren_Task()
Dim i As Integer
Application.ScreenUpdating = False
'alles einblenden
Dim af As Variant
With ActiveSheet
If .AutoFilterMode Then
For Each af In .AutoFilter.Filters
If af.On Then
.ShowAllData
Exit For
End If
Next
End If
End With
Application.ScreenUpdating = True
'Zeile kopieren
i = ActiveCell.Row
Rows(i + 1 & ":" & i + 1).Select
Selection.Insert Shift:=xlDown
Rows(i & ":" & i).Select
Selection.Copy
Range("A" & i + 1).Select
ActiveSheet.Paste
Range("T" & i + 1).ClearContents
Range("U" & i + 1).ClearContents
Range("G" & i + 1).Select
Range("G" & i + 1).Value = InputBox("bitte Sprint-Woche eingeben:", "Sprint Woche", " _
Sprint_" & Range("B1"))
Range("H" & i + 1).Select
Range("H" & i + 1).Value = InputBox("bitte Sprint-Ziel eingeben:", "Sprint Ziel", Range("H"  _
& i))
Range("N" & i + 1).Select
Range("N" & i + 1).Value = InputBox("bitte Task eingeben:", "Task", Range("N" & i))
'gemerkten Filter wiederherstellen
If Worksheets("Hilfe").Range("F2").Value = "Filter SW" Then
Call filter_SW
End If
If Worksheets("Hilfe").Range("F2").Value = "Filter ME" Then
Call filter_ME
End If
If Worksheets("Hilfe").Range("F2").Value = "Filter EE" Then
Call filter_EE
End If
If Worksheets("Hilfe").Range("F2").Value = "Filter PS" Then
Call filter_PS
End If
If Worksheets("Hilfe").Range("F2").Value = "Filter CRE" Then
Call filter_CRE
End If
If Worksheets("Hilfe").Range("F2").Value = "kein Filter" Then
Call AutofilterRücksetzen
End If
'gemerkte Sprints wiederherstellen
If Worksheets("Hilfe").Range("F3").Value = "3-Wochen-Sprints" Then '3 Wochen Sprint
Call TasksAusblenden
End If
If Worksheets("Hilfe").Range("F3").Value = "alle Sprints" Then 'alle Sprints
Call TasksEinblenden
End If
If Worksheets("Hilfe").Range("F3").Value = "aktueller Sprint" Then 'aktueller Sprint
Call AktuelleTasks
End If
'neue Zeile markieren
Rows(i + 1 & ":" & i + 1).Select
End Sub

Anzeige

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

Betreff
Datum
Anwender
Anzeige
AW: bestimmte Anzahl an Zeilen kopieren und einfügen
23.08.2018 17:18:27
Robert
Hallo,
versuche es mal so:
Sub ZeileKopieren_Task()
Dim i As Integer, cl As Range
Application.ScreenUpdating = False
'alles einblenden
Dim af As Variant
With ActiveSheet
If .AutoFilterMode Then
For Each af In .AutoFilter.Filters
If af.On Then
.ShowAllData
Exit For
End If
Next
End If
End With
Application.ScreenUpdating = True
For Each cl In Selection.Cells
'Zeile kopieren
i = cl.Row + 1
cl.EntireRow.Copy
cl.Offset(1, 0).EntireRow.Insert shift:=xlShiftDown
Range("T" & i & ":U" & i).ClearContents
Range("G" & i).Value = InputBox("bitte Sprint-Woche eingeben:", "Sprint Woche", "Sprint" &  _
Range("B1"))
Range("H" & i).Value = InputBox("bitte Sprint-Ziel eingeben:", "Sprint Ziel", Range("H" & i) _
)
Range("N" & i).Value = InputBox("bitte Task eingeben:", "Task", Range("N" & i))
Next
'gemerkten Filter wiederherstellen
Select Case Worksheets("Hilfe").Range("F2").Value
Case "Filter SW"
Call filter_SW
Case "Filter ME"
Call filter_ME
Case "Filter EE"
Call filter_EE
Case "Filter PS"
Call filter_PS
Case "Filter CRE"
Call filter_CRE
Case "kein Filter"
Call AutofilterRücksetzen
End Select
'gemerkte Sprints wiederherstellen
Select Case Worksheets("Hilfe").Range("F3").Value
Case "3-Wochen-Sprints"  '3 Wochen Sprint
Call TasksAusblenden
Case "alle Sprints"       'alle Sprints
Call TasksEinblenden
Case "aktueller Sprint"    'aktueller Sprint
Call AktuelleTasks
End Select
End Sub
In dem eingefügten For Each-Block werden die einzelnen Zellen der Markierung durchlaufen und die jeweilige Zeile kopiert und eine Zeile tiefer eingefügt. Da ich vermute, dass die neue Zeile die alte nicht überschreiben soll, habe ich dort die Insert-Anweisung verwendet. Wenn also z. B. die Zelle B3 markiert ist, wird die Zeile 3 kopiert und zwischen der Zeile 3 und 4 eingefügt. Die alte Zeile 4 ist dann Zeile 5. Soll es anders sein, so wie in Deinem Makro, dass also die alte Zeile 4 in dem Fall mit einer Kopie der Zeile 3 überschrieben werden soll, muss die Codezeile
cl.Offset(1, 0).EntireRow.Insert shift:=xlShiftDown

in
ActiveSheet.Paste Destination:=cl.Offset(1, 0).EntireRow

geändert werden.
Um den Zellen mit den Abfragen neue Werte zu geben, müssen die nicht extra mit Select ausgewählt werden. Außerdem habe ich die ganzen If..then-Anweisungen in zwei Select Case-Anweisungen geändert, das finde ich übersichtlicher.
Schau Dir es mal an.
Gruß
Robert
Anzeige
AW: bestimmte Anzahl an Zeilen kopieren
24.08.2018 08:32:23
VBA
Hallo Robert,
vielen Dank dass du mir helfen möchtest. Und auch für die CASE-Änderung, ist definitiv eleganter
Hab es getestet und bin auf 2 Dinge gestoßen:
a) 1 Zeile markiert - Makro kopiert die Zeile und geht in debugger. Ich habe auf dem Blatt noch folgendes Makro, hier markiert er die if-Bedingung if target.value...
Private Sub Worksheet_Change(ByVal Target As Range)
'Datum setzen in Spalte T (20)
If Target.Column = 20 Then
If Target.Value = "ongoing" Or Target.Value = "0%" _
Or Target.Value = "25%" Or Target.Value = "50%" _
Or Target.Value = "75%" Or Target.Value = "100%" Then _
Target.Offset(0, 1).Value = Date
End If
End Sub
Mit meinem jetzigen makro funktioniert das, jetzt nicht mehr. Nach dem Löschen des kleinen Makros geht alles
b) mehrere Zeilen markiert - Makro geht in Endlos-Schleife wobei die Originalmarkierung bestehen bleibt. Kopiert werden aber immer die neu-angelegten Zeilen
Hast du hier noch eine Idee?
Danke
Gruß
Klaus
Anzeige
AW: bestimmte Anzahl an Zeilen kopieren
24.08.2018 09:43:21
Robert
Hallo,
ich habe das Makro etwas angepasst. Jetzt könnte es laufen. Zur Erklärung:
Zu Deiner Anmerkung "a) 1 Zeile markiert - Makro kopiert die Zeile und geht in debugger. Ich habe auf dem Blatt noch folgendes Makro, hier markiert er die if-Bedingung if target.value..."
Im Rahmen des von mir erstellten Makros werden ja die Inhalte der Spalten T und U gelöscht. Das Worksheet_Change-Ereignis hat dann aber das Problem, dass in diesem Makro der Target, also die geänderten Zellen, über 2 Spalten (T und U) liegen, das ist bei Deinem Worksheet_Change-Ereignis nicht vorgesehen. Zur Behebung dieses Fehlers habe ich die Abarbeitung der Ereignisse (Worksheet_Change und andere) am Anfang mit Application.EnableEvents = False abgeschaltet und am Ende mit Application.EnableEvents = True wieder eingeschaltet.
Zu Deiner Anmerkung "b) mehrere Zeilen markiert - Makro geht in Endlos-Schleife wobei die Originalmarkierung bestehen bleibt. Kopiert werden aber immer die neu-angelegten Zeilen"
Bei meinen Tests hier hatte ich, wenn ich mehrere Zeilen markiert habe, diese immer mit gedrückter Strg-Taste einzeln angeklickt, dann hat das Makro geklappt. Nach Deinem letzten Post habe ich mehrere Zeilen markiert, indem ich über diese mit gedrückter Maustaste z. B. von B4 zu B6 gefahren bin. Dabei trat der geschilderte Fehler auf. Ich habe das Makro jetzt dahingehend geändert, dass die ausgewählten Zellen von unten abgearbeitet werden. Dadurch kann eine neu eingefügte Zeile nicht mehr die Zell-Adressen der noch abzuarbeitenden Zellen verändern. Am Ende wird jetzt die erste neu eingefügte Zeile markiert.
Noch eine Anmerkung: Wenn in einer Zeile 2 oder mehr Zellen markiert sind, wird diese Zeile auch 2-oder mehrfach kopiert. Wenn das auch noch abgefangen werden soll, gib bitte Bescheid.
Hier das geänderte Makro, die geänderten Stellen habe ich rot gekennzeichnet.
Sub ZeileKopieren_Task()
Dim i As Integer, cl As Range, j As Integer
Application.ScreenUpdating = False
Application.EnableEvents = False
'alles einblenden
Dim af As Variant
With ActiveSheet
If .AutoFilterMode Then
For Each af In .AutoFilter.Filters
If af.On Then
.ShowAllData
Exit For
End If
Next
End If
End With
Application.ScreenUpdating = True
For j = Selection.Cells.Count To 1 Step -1
'Zeile kopieren
i = Selection.Cells(j).Row + 1
Selection.Cells(j).EntireRow.Copy
Selection.Cells(j).Offset(1, 0).EntireRow.Insert shift:=xlShiftDown
Range("T" & i & ":U" & i).ClearContents
Range("G" & i).Value = InputBox("bitte Sprint-Woche eingeben:", "Sprint Woche", "Sprint" &  _
Range("B1"))
Range("H" & i).Value = InputBox("bitte Sprint-Ziel eingeben:", "Sprint Ziel", Range("H" & i) _
)
Range("N" & i).Value = InputBox("bitte Task eingeben:", "Task", Range("N" & i))
Next
Selection.Cells(1).Offset(1, 0).EntireRow.Select
'gemerkten Filter wiederherstellen
Select Case Worksheets("Hilfe").Range("F2").Value
Case "Filter SW"
Call filter_SW
Case "Filter ME"
Call filter_ME
Case "Filter EE"
Call filter_EE
Case "Filter PS"
Call filter_PS
Case "Filter CRE"
Call filter_CRE
Case "kein Filter"
Call AutofilterRücksetzen
End Select
'gemerkte Sprints wiederherstellen
Select Case Worksheets("Hilfe").Range("F3").Value
Case "3-Wochen-Sprints"  '3 Wochen Sprint
Call TasksAusblenden
Case "alle Sprints"       'alle Sprints
Call TasksEinblenden
Case "aktueller Sprint"    'aktueller Sprint
Call AktuelleTasks
End Select
Application.EnableEvents = True
End Sub
Gruß
Robert
Anzeige
AW: bestimmte Anzahl an Zeilen kopieren
24.08.2018 10:22:17
VBA
Hallo Robert,
danke, funktioniert nun sehr gut.
Robuster wäre es natürlich, wenn du die Zeilen-mehrfach-Auswahl unterbindest, guter Vorschlag.
Wäre es noch möglich, dass am Ende des Makros alle eingefügten Zeilen markiert sind?
Danke
Gruß
Klaus
AW: bestimmte Anzahl an Zeilen kopieren
24.08.2018 13:12:49
Robert
Hallo,
probiere mal folgendes.Ich habe an dem Makro noch andere Änderungen vorgenommen, da das alte seltsamerweise jetzt bei mir nicht mehr richtig funktionierte.
Sub ZeileKopieren_Task2()
Dim i As Integer, cl As Range, j As Integer, lZ As Long
Dim strZeilen As String, strZeilenNeu As String, lZeilenNeu() As Long, k As Integer
Application.ScreenUpdating = False
Application.EnableEvents = False
'alles einblenden
Dim af As Variant
With ActiveSheet
If .AutoFilterMode Then
For Each af In .AutoFilter.Filters
If af.On Then
.ShowAllData
Exit For
End If
Next
End If
End With
Application.ScreenUpdating = True
strZeilen = ";"
ReDim lZeilenNeu(0)
For Each cl In Selection.Cells
If InStr(strZeilen, ";" & cl.Row & ";") = 0 Then
strZeilen = strZeilen & cl.Row & ";"
If lZ  0 Then
Rows(j).Copy
Rows(j).Offset(1, 0).EntireRow.Insert shift:=xlShiftDown
Range("T" & j + 1 & ":U" & j + 1).ClearContents
Range("G" & j + 1).Value = InputBox("bitte Sprint-Woche eingeben:", "Sprint Woche", " _
Sprint" & Range("B1"))
Range("H" & j + 1).Value = InputBox("bitte Sprint-Ziel eingeben:", "Sprint Ziel", Range( _
"H" & j + 1))
Range("N" & j + 1).Value = InputBox("bitte Task eingeben:", "Task", Range("N" & j + 1))
For k = 0 To UBound(lZeilenNeu)
lZeilenNeu(k) = lZeilenNeu(k) + 1
Next k
ReDim Preserve lZeilenNeu(UBound(lZeilenNeu) + 1)
lZeilenNeu(UBound(lZeilenNeu)) = j + 1
End If
Next j
For k = 1 To UBound(lZeilenNeu)
strZeilenNeu = strZeilenNeu & ", " & lZeilenNeu(k) & ":" & lZeilenNeu(k)
Next k
Range(Mid(strZeilenNeu, 3)).Select
'gemerkten Filter wiederherstellen
Select Case Worksheets("Hilfe").Range("F2").Value
Case "Filter SW"
Call filter_SW
Case "Filter ME"
Call filter_ME
Case "Filter EE"
Call filter_EE
Case "Filter PS"
Call filter_PS
Case "Filter CRE"
Call filter_CRE
Case "kein Filter"
Call AutofilterRücksetzen
End Select
'gemerkte Sprints wiederherstellen
Select Case Worksheets("Hilfe").Range("F3").Value
Case "3-Wochen-Sprints"  '3 Wochen Sprint
Call TasksAusblenden
Case "alle Sprints"       'alle Sprints
Call TasksEinblenden
Case "aktueller Sprint"    'aktueller Sprint
Call AktuelleTasks
End Select
Application.EnableEvents = True
End Sub
Gruß
Robert
Anzeige
AW: bestimmte Anzahl an Zeilen kopieren
30.08.2018 09:43:13
VBA
Hallo Robert,
war 3 Tage außer Haus, deshalb erst jetzt eine Antwort.
Kopieren funktioniert einwandfrei, vielen herzlichen Dank dafür. Er markiert zwar die neuen Zeilen nicht, kann aber gut damit leben.
Gruß
Klaus
;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken
Anzeige
Anzeige

Infobox / Tutorial

Bestimmte Anzahl an Zeilen kopieren und einfügen in Excel


Schritt-für-Schritt-Anleitung

Um eine bestimmte Anzahl von Zeilen in Excel zu kopieren und einzufügen, kannst Du ein VBA-Makro verwenden. Hier ist eine einfache Schritt-für-Schritt-Anleitung:

  1. Öffne den VBA-Editor: Drücke ALT + F11, um den VBA-Editor zu öffnen.

  2. Füge ein neues Modul hinzu: Klicke auf Einfügen > Modul.

  3. Kopiere den folgenden Code in das Modul:

    Sub ZeileKopieren_Task()
       Dim i As Integer, cl As Range
       Application.ScreenUpdating = False
       Application.EnableEvents = False
       ' alles einblenden
       Dim af As Variant
       With ActiveSheet
           If .AutoFilterMode Then
               For Each af In .AutoFilter.Filters
                   If af.On Then
                       .ShowAllData
                       Exit For
                   End If
               Next
           End If
       End With
       Application.ScreenUpdating = True
       For Each cl In Selection.Cells
           i = cl.Row + 1
           cl.EntireRow.Copy
           cl.Offset(1, 0).EntireRow.Insert shift:=xlShiftDown
           Range("T" & i & ":U" & i).ClearContents
           Range("G" & i).Value = InputBox("bitte Sprint-Woche eingeben:", "Sprint Woche", "Sprint" & Range("B1"))
           Range("H" & i).Value = InputBox("bitte Sprint-Ziel eingeben:", "Sprint Ziel", Range("H" & i))
           Range("N" & i).Value = InputBox("bitte Task eingeben:", "Task", Range("N" & i))
       Next
       Application.EnableEvents = True
    End Sub
  4. Schließe den VBA-Editor und kehre zu Excel zurück.

  5. Markiere die Zeilen, die Du kopieren möchtest.

  6. Führe das Makro aus: Drücke ALT + F8, wähle ZeileKopieren_Task und klicke auf Ausführen.


Häufige Fehler und Lösungen

  • Fehler bei der Ausführung des Makros: Wenn das Makro in den Debugger springt, könnte es an einer nicht behandelten Änderung im Arbeitsblatt liegen. Stelle sicher, dass Du Application.EnableEvents = False am Anfang und Application.EnableEvents = True am Ende des Makros verwendest.

  • Endlosschleife bei mehreren Zeilen: Wenn das Makro in eine Endlosschleife gerät, prüfe, ob Du die Zellen von unten nach oben abarbeitest, um zu verhindern, dass neue Zeilen die noch abzuarbeitenden Zeilen beeinflussen.


Alternative Methoden

Wenn Du keine VBA-Programmierung nutzen möchtest, kannst Du auch die Funktion "Kopieren und Einfügen" in Excel nutzen:

  1. Markiere die gewünschten Zeilen.
  2. Rechtsklick und "Kopieren" wählen.
  3. Rechtsklick auf die Zielzeile und "Einfügen" auswählen.

Diese Methode ist jedoch weniger flexibel, da Du keine spezifischen Eingabefelder für zusätzliche Daten hast.


Praktische Beispiele

  • Beispiel 1: Du hast eine Liste von Projekten in Excel und möchtest für jedes Projekt eine neue Zeile für die Sprint-Woche und das Sprint-Ziel einfügen. Verwende das oben genannte Makro, um die Aufgaben effizient zu kopieren und die neuen Informationen einzugeben.

  • Beispiel 2: Wenn Du mehrere Zeilen in einer Tabelle hast, die Du für die gleiche Aufgabe kopieren und anpassen möchtest, kannst Du die Auswahl mehrerer Zellen vor dem Ausführen des Makros vornehmen.


Tipps für Profis

  • Makros anpassen: Du kannst das Makro anpassen, um spezifische Werte automatisch einzufügen, indem Du Standardwerte in den InputBox-Funktionen verwendest.
  • Fehlerbehebung: Verwende Debug.Print innerhalb des Makros, um den Status und die Werte während des Ablaufs zu überprüfen. Das hilft, Fehlerquellen schnell zu identifizieren.

FAQ: Häufige Fragen

1. Wie kann ich das Makro für eine bestimmte Anzahl von Zeilen anpassen? Du kannst die Schleife im Makro so anpassen, dass sie nur für die gewünschten Zeilen läuft, indem Du die Selection.Cells-Eigenschaft modifizierst.

2. Gibt es eine Möglichkeit, nur einzigartige Zeilen zu kopieren? Ja, Du kannst eine Prüfung in das Makro einfügen, um sicherzustellen, dass nur einzigartige Zeilen kopiert werden, indem Du eine Liste von bereits kopierten Zeilen führst.

3. Funktioniert das Makro in allen Excel-Versionen? Das Makro sollte in den meisten modernen Versionen von Excel (z.B. Excel 2010 und höher) funktionieren, da es grundlegende VBA-Funktionen verwendet.

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige