Makro zum Zeile duplizieren

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Grau() Dim LR As Long, i As Long With ActiveSheet LR = .Cells(.Rows.Count, "A").End(xlUp).Row 'letzte Zeile der Spalte A For i = LR To 2 Step -1 If .Cells(i, 1).Interior.Color = 15921906 Then .Rows(i + 1).Insert .Rows(i).Copy .Rows(i + 1) End If Next End With End Sub

Hallo Emanuel,
natürlich ist es möglich, und gar nicht mal kompliziert. Es macht bei ein so einfache Vorhaben, wenig Sinn, von jemand anderen abhängig zu werden.
Daher anbei der Vorgehensweise, wie Du das selber auf die Bein stellen, prüfen und nachkorrigieren kann.
Erste Schritt ist der Zusatz-Mnü "Entwicklertools" sichtbar zu machen: nach Rechtsklick auf dem Menü "Menüband anpassen..." setzst Du in der rechte Spalte der Hauptregisterkarten einen Haken bei "Entwicklertools" an. Mit ok Schliessen.
Jetzt hast Du den Menü "Entwicklertools" zur Verfügung. Darin ist links die Funktion "Makro aufzeichnen", was auch als Makro-Rekorder bekannt.
_ Aufnahme einschalten, vorgeschlagene Einstellungen ("Makro1", "Diese Arbeitsmappe") einfach so nehmen. Der Schrift von "Makro aufzeichen" ändert sich in "Aufzeichnung beenden"
_ Zeile 2 markieren
_ kopieren
_ Zeile 3 markieren
_ Zeile einfürgen
_ Makro-Aufzeichnung beenden
Dann in "Entwicklertools", "Visual Basic" anklicken (alternativ Alt+F11)
Du bist dann in Visual Basic Editor.
Links deiner Projektstruktur (sieht wie eine Verzeichnisstruktur), den "Projekt Explorer" (wenn nicht sichtbar: Menü "Ansicht", "Projekt Explorer")
Jede "Objekt" hat sein eigenen "Codepane": "DieseArbeitsmappe" für die ganze Datei und jedes Blatt unter "Tabelle1", "Tabelle2", ..., aber auch den globalen Code unter Modul. Öffne "Module" und Doppleklicke auf "Modul1". Da ist der Code, den der Makro-Rekorder aufgenommen hat.
Es lässt sich leicht lesen, auch wenn der Vokabular zuerst neu ist:


Sub Makro2()
' Makro2 Makro
Rows("2:2").Select
Selection.Copy
Rows("3:3").Select
Selection.Insert Shift:=xlDown
End Sub

auf Deutsch:
_ die Zeile(n) (Row) 2 bis 2 wurde(n) selektiert
_ die Selektion kopiert
_ die Zeile 3 bis 3 selektiert
_ es wurde "inseriert", in dem das Vorhandenen nach unten verschoben worden ist.
Jetzt ist die Frage:
wie kann man aus diesem Code etwas flexibleres machen, spricht nicht immer die Zeile 2 sondern die Zeile, wo man sich befindet?
Hier ist es komplizierter, weil man wissen muss, welche Vokabular eingesetzt werden soll: EntireRow, Offset, ... (diese Vokabular lernst Du immer mehr bei jeder Makro-Aufzeichnung)


Sub ZeileUnten_kopieren()
Selection.Range("A1").EntireRow.Copy
Selection.Offset(1, 0).Select
Selection.Insert Shift:=xlDown
End Sub

Auf Deutsch:
_ aus der Selektion die erste obere linke Zelle (relativ gesehen die "A1" von der Selektion"), davon die ganze Zeile (EntireRow) kopieren,
_ aus der Selektion eine "Bewegung" von eine Zeile nach unten und null Spalten nach Rechts gehen und diese selektieren
_ auf die neue Selektion das Kopierten inserieren.
Verstehst Du etwa einen Wort nicht, so lege dein Cursor auf das Wort und drücke Strg+F1. Du gelangst in der Online-Hilfe. Darin sind auch viele einfache Beispiele, die
Note: da Original und Kopie sich nicht unterscheiden, hätten man auch auf Zeile 2 kopieren, anstatt Zeile 3. Aber es gibt die Möglichkeit, mehr zu erklären ;-)
Das waren deien erste Schritten. Ich hoffe, Du bist daraus mehr neugierig als angeschreckt. Möge noch viele Schritte dazu kommen.
VG
Yal
(Nachtrag: Du kannst unter "Daten", auf der Pfeil unten recht im Funktionsblock "Gleiderung", bewirken, dass bei Grupppierung von Zeilen die "Hauptzeile" über die Detaildaten vorkommt anstatt unten. Einfach probieren)

Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim SP As Integer, Z As Long SP = 10 ' Nur bei click in Spalte J If Not Intersect(Target, Columns(SP)) Is Nothing Then If Target.Count = 1 Then ' nur wenn eine Zelle gewählt wurde Z = Target.Row ' Nur wenn Grau If Cells(Z, 1).Interior.Color = 15921906 Then Rows(Z + 1).Insert Rows(Z).Copy Rows(Z + 1) End If End If End If End Sub

Hallo
es ist nicht sinnvoll in ein Blatt dutzende Button einzufügen, die jedesmal eine neue Zeile zugewiesen bekommen müssen, um neue Zeilen einzufügen.
Man nimmt nur einen Button den man ganz oben in die Überschrtiftszeile setzt, und der das ganze für ALLE Zeilen elegant erledigt.
Interessanterweise hat dir der Kollege Yal dazu schon einen guten Vorschlag gemacht. Ich habe ihn etwas verbessert, achte auf die Innenfarbe.
Setze den Cursor bitte in die Zeile die kopiert werden soll. Den Rest erledigt das Makro. So oft du drückst fügt es eine neue Zeile an der Stelle ein.
mfg Piet


Sub Makro1()
If ActiveCell.Interior.ColorIndex = 2 Then
Rows(ActiveCell.Row).Copy
Rows(ActiveCell.Row + 1).Insert Shift:=xlDown
Application.CutCopyMode = False
End If
End Sub

Beliebteste Forumthreads (12 Monate)

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread