Makro Zeilen kopieren, mehrfach darunter einfügen

Computer: Software & Programmierung Office Software
#1

Hallo,

ich hätte eine Anfrage für ein Makro, hab überall gesucht aber leider nicht wirklich fündig geworden. Bin auch bei VBA leider nur sehr anfängermäßg unterwegs.

Grundsätzlich geht es darum die Zeilen einer (langen) Excel-Tabelle immer zu kopieren und 4x darunter einzufügen (natürlich so, dass die nachfolgenden Zeilen nicht überschrieben werden).

Die entstehenden „5er Blöcke“ sollen außerdem grau bzw. nicht grau markiert werden.

Beispielliste:
Name1 Kostenstelle1 Business Area1
Name2 Kostenstelle2 Business Area2
Name3 Kostenstelle3 Business Area3
usw.

Name1 Kostenstelle1 Business Area1 (Zeile grau)
Name1 Kostenstelle1 Business Area1 (Zeile grau)
Name1 Kostenstelle1 Business Area1 (Zeile grau)
Name1 Kostenstelle1 Business Area1 (Zeile grau)
Name1 Kostenstelle1 Business Area1 (Zeile grau)
Name2 Kostenstelle2 Business Area2
Name2 Kostenstelle2 Business Area2
Name2 Kostenstelle2 Business Area2
Name2 Kostenstelle2 Business Area2
Name2 Kostenstelle2 Business Area2
Name3 Kostenstelle3 Business Area3 (Zeile grau)
Name3 Kostenstelle3 Business Area3 (Zeile grau)
Name3 Kostenstelle3 Business Area3 (Zeile grau)
Name3 Kostenstelle3 Business Area3 (Zeile grau)
Name3 Kostenstelle3 Business Area3 (Zeile grau) usw.
usw.

Kann jemand helfen?

Danke im Voraus.

Beste Grüße
Ecke_No1

#2

Hallo Ecke,

wie sieht deine Tabelle aus? Wie in Zeile 1 oder zeile2?

Tabellenblatt: [Mappe1]!Tabelle2
 │ A │ B │ C │ D │
──┼────────────────────────────────────┼───────────────┼──────────┼───────┤
1 │ Name1 Kostenstelle1 Business Area1 │ │ │ │
──┼────────────────────────────────────┼───────────────┼──────────┼───────┤
2 │ Name1 │ Kostenstelle1 │ Business │ Area1 │
──┴────────────────────────────────────┴───────────────┴──────────┴───────┘
A1:smiley:2
haben das Zahlenformat: Standard

Tabellendarstellung erreicht mit dem Code in FAQ:2363
Gruß
Reinhard

#3

Hallo Reinard,

wie in Zeile 2, also Name = Spalte A, Kostenstelle = Spalte B etc.

Danke.

Erik

#4

wie in Zeile 2, also Name = Spalte A, Kostenstelle = Spalte B
etc.

Hallo Erik,

Sub Einfuegen()
Dim Zei As Long, colC As New Collection
For Zei = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
 Cells(Zei + 1, 1).Resize(4, 5).EntireRow.Insert
 colC.Add Item:=CStr((Zei - 1) \* 5 + 1), key:=CStr((Zei - 1) \* 5 + 1)
Next Zei
For Zei = 1 To colC.Count
 Rows(colC(Zei)).Copy Destination:=Rows(colC(Zei) + 1 & ":" & colC(Zei) + 4)
 If colC(Zei) Mod 2 = 1 Then Rows(colC(Zei) & ":" & colC(Zei) + 4).Interior.ColorIndex = 15
Next Zei
End Sub

Gruß
Reinhard

#5

Hallo Reinhard,
funkioniert perfekt…vielen Dank für Deine Hilfe!
Freundliche Grüße
Erik