Zeilen verdoppeln / kopieren

Computer: Software & Programmierung Office Software
#1

Liebe ExcelianerInnen,

ich habe folgendes Problem:

Im Tabellenblatt „Tabelle 1“ gibt es ca. 600 Zeilen. Die soll ich so bearbeiten, dass es eine Originalzeile mit Inhalten gibt und eine kopierte, in der ich die Änderungen eintrage.
Die Zeile 1 (bis 600) soll also verdoppelt werden mit dem identischen Inhalt. Die Inhalte der Zellen reichen von A1:E1 wie auch von A1:AF1 und noch weiter. Es sollte also die gesamte Zeile sein, die unterhalb der Originalzeile kopiert wird. Die Krönung wäre, wenn die kopierte Zeile eine andere Farbe hätte, z. B. hellgelb, damit sie besser unterscheidbar wären.

Ist sowas per Makro bzw. VBA möglich?

Vielen Dank für eventuelle Antworten, in der Hoffnung, ausreichend beschrieben zu haben.

Liebe Grüße

Jorge

#2

Im Tabellenblatt „Tabelle 1“ gibt es ca. 600 Zeilen. Die soll
ich so bearbeiten, dass es eine Originalzeile mit Inhalten
gibt und eine kopierte, in der ich die Änderungen eintrage.
Die Zeile 1 (bis 600) soll also verdoppelt werden mit dem
identischen Inhalt. Die Inhalte der Zellen reichen von A1:E1
wie auch von A1:AF1 und noch weiter. Es sollte also die
gesamte Zeile sein, die unterhalb der Originalzeile kopiert
wird. Die Krönung wäre, wenn die kopierte Zeile eine andere
Farbe hätte, z. B. hellgelb, damit sie besser unterscheidbar
wären.

Hallo Jorge,

nachfolgender Code benutzt BA als Hilfsspalte.
Teste ihn mal in einer Kopie deiner Mappe.

Alt+F11, Einfügen—Modul, Code reinkopieren, Editor schließen.
Zum Code starten Alt+F8…

Gruß
Reinhard

Option Explicit

Sub Doppeln()
Dim Zei As Long
With Worksheets("Tabelle1")
 Zei = .Cells(Rows.Count, 1).End(xlUp).Row
 .Rows("1:" & Zei).Copy .Cells(Zei + 1, 1)
 .Range("BA1:BA" & Zei).Formula = "=ROW(A1)"
 .Range("BA" & Zei + 1 & ":BA" & 2 \* Zei).Formula = "=ROW(A1)"
 .Range("BA1:BA" & 2 \* Zei).Value = .Range("BA1:BA" & 2 \* Zei).Value
 .Range("A1:BA" & 2 \* Zei).Sort Key1:=.Range("BA1"), Order1:=xlAscending, Header:=xlNo, \_
 OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
 .Range("BA:BA").ClearContents
 .Range("A1:BA" & 2 \* Zei).FormatConditions.Delete
 .Range("A1:BA" & 2 \* Zei).FormatConditions.Add Type:=xlExpression, Formula1:= \_
 "=REST(ZEILE();2)=0"
 .Range("A1:BA" & 2 \* Zei).FormatConditions(1).Interior.ColorIndex = 38
End With
End Sub
#3

Hallo Reinhard,

funktioniert einwandfrei und auch die Farbe ist schöner als das helle gelb.

Wieder Mal vielen Dank!

Gruß

Jorge

#4

Lieber Reinhard und KollegInnen,

ich habe jetzt doch noch eine Bitte. Die Unterscheidung der 2. zur 1. Zeile ist trotz Farbe nicht ausreichend. Geht auch noch „fett“ dazu?
Ich habe etliche Male probiert, irgendwas mit „bold = true“ zu ergänzen und immer kam die Frage, ob ich debuggen will? Frustrierend!

Wäre schön, wenn du noch mal helfen könntest.

Liebe Grüße

Jorge

Option Explicit

Sub Doppeln()
Dim Zei As Long
With Worksheets(„Tabelle1“)
Zei = .Cells(Rows.Count, 1).End(xlUp).Row
.Rows(„1:“ & Zei).Copy .Cells(Zei + 1, 1)
.Range(„BA1:BA“ & Zei).Formula = „=ROW(A1)“
.Range(„BA“ & Zei + 1 & „:BA“ & 2 * Zei).Formula = „=ROW(A1)“
.Range(„BA1:BA“ & 2 * Zei).Value = .Range(„BA1:BA“ & 2 *
Zei).Value
.Range(„A1:BA“ & 2 * Zei).Sort Key1:=.Range(„BA1“),
Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
.Range(„BA:BA“).ClearContents
.Range(„A1:BA“ & 2 * Zei).FormatConditions.Delete
.Range(„A1:BA“ & 2 * Zei).FormatConditions.Add
Type:=xlExpression, Formula1:= _
„=REST(ZEILE();2)=0“
.Range(„A1:BA“ & 2 *
Zei).FormatConditions(1).Interior.ColorIndex = 38
End With
End Sub

#5

Geht auch noch „fett“ dazu?
Ich habe etliche Male probiert, irgendwas mit „bold = true“ zu
ergänzen und immer kam die Frage, ob ich debuggen will?

Da kam von Excel/Vba ein Fensterchen wo drin stand: „Wollen Sie debuggen?“
Haste aber ein nettes Excel *auchhabenwill* :smile:
bold=true ist schon mal ein sehr guter Ansatz.

Wäre schön, wenn du noch mal helfen könntest.

Ja, Jojoerfahren kenn ich mich mit mager und fett bestens aus *gg*

Gruß
Reinhard

Sub Doppeln()
Dim Zei As Long
With Worksheets("Tabelle1")
 Zei = .Cells(Rows.Count, 1).End(xlUp).Row
 .Rows("1:" & Zei).Copy .Cells(Zei + 1, 1)
 .Range("BA1:BA" & Zei).Formula = "=ROW(A1)"
 .Range("BA" & Zei + 1 & ":BA" & 2 \* Zei).Formula = "=ROW(A1)"
 .Range("BA1:BA" & 2 \* Zei).Value = .Range("BA1:BA" & 2 \* Zei).Value
 .Range("A1:BA" & 2 \* Zei).Sort Key1:=.Range("BA1"), Order1:=xlAscending, Header:=xlNo, \_
 OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
 .Range("BA:BA").ClearContents
 .Range("A1:BA" & 2 \* Zei).FormatConditions.Delete
 .Range("A1:BA" & 2 \* Zei).FormatConditions.Add Type:=xlExpression, Formula1:= \_
 "=REST(ZEILE();2)=0"
 .Range("A1:BA" & 2 \* Zei).FormatConditions(1).Interior.ColorIndex = 38
 **.Range("A1:BA" & 2 \* Zei).FormatConditions(1).Font.Bold = True**  
End With
End Sub
#6

Da kam von Excel/Vba ein Fensterchen wo drin stand: „Wollen
Sie debuggen?“

Nee, natürlich nicht. Aber ich tu immer so, als würde Excel oder Word mit mir reden und machen aus einem Wort einen korrekten Satz:smile::

.Range(„A1:BA“ & 2 * Zei).FormatConditions(1).Font.Bold = True
End With
End Sub

Also, wenn du „nur“ die letzte Zeile angehängt hast, war ich ich nicht schlecht. Ich bin nur nicht auf das b und /b gekommen und ich hab aus der (1) eine (2) gemacht. Siehst mal, deine Schule!

Danke.

Gruß
Jorge