Hallo,
markiere die Zeile und drücke die Tasten "Strg" und "+" ,so oft wie es brauchst
mfg
wolfgang

Hi!
Danke für die schnelle Antwort.

Ich habe leider vergessen zu schreiben, dass ich dies in ein Makro
einbauen möchte! Sorry! Hast Du dazu auch einen Vorschlag!
Ich benötige die Zeilen zwischen zwei unterschiedlichen Datumswerten, die in variablen Zeilen sind.

Gruss
Ines

Hallo Ines,
vielleicht hilft dir das Makro weiter bei deinem Wochenraumplan weiter:
Option Explicit
Sub Zeile_einfügen()
Application.ScreenUpdating = False
'fügt nach gleichen Datum leere Zeile ein
Dim lngZeile As Long ' Zeilenzähler
Dim bFirst As Boolean ' Flag für 1. Eintrag eines Artikels
lngZeile = 7 ' Start in Zeile 7
bFirst = True ' am Anfang haben wir immer einen 1. Datum
While Cells(lngZeile, 1) > "" ' Solange in der 1. Spalte der Zeile was steht
If bFirst Then ' falls 1. Eintrag
bFirst = False ' jetzt nicht mehr
Else ' nicht der 1. Eintrag
' Test auf Datumwechsel, d.h. der Wert in Spalte A ist identisch mit dem der vorherigen Zeile
If Cells(lngZeile, 1) = Cells(lngZeile - 1, 1) Then
Else ' unterschiedliche Datum
' neue Zeile einfügen
Rows(lngZeile).Insert
' Zeilenzähler anpassen
lngZeile = lngZeile + 1
' Leerzeile einfügen
Rows(lngZeile).Insert
' Jetzt haben wird wieder einen 1. Eintrag
bFirst = True
End If
End If
lngZeile = lngZeile + 1 ' eine Zeile weiter
Wend
Range("A8") = Range("A7")
Range("A11") = Range("A10")
Range("A14") = Range("A13")
Range("A17") = Range("A16")
Range("A20") = Range("A19")
Range("A23") = Range("A22")
Range("A26") = Range("A25")
End Sub

Muster Datei

Gruß
fedjo

Hallo Fedjo!

Sieht super aus, was Du da gestrickt hast!
Vielen Dank dafür!

Zeige mit aber bitte noch die Stelle, an der die Anzahl der zusätzlichen
Zeilen deklariert ist, damit ich die Möglickeit habe, da noch zu variieren.

Gruss

Ines

Hallo Ines,
habe das Makro verändert für deinen Wochenraumplan:

Sub Zeilen_einfügen()
Dim intI As Integer, intLetzte As Integer
intLetzte = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = False
For intI = intLetzte To 7 Step -1 'Ab Zeile 7
If Cells(intI, 1).Value <> Cells(intI - 1, 1).Value Then

Rows(intI + 1).Value = Rows(intI).Value 'Datum eine Zeile nach unten
Rows(intI + 2).Value = Rows(intI).Value 'Datum zeite Zeile nach unten
Rows(intI & ":" & intI + 2).Insert Shift:=xlDown 'zwei leere Zeilen einfügen
End If
Next
Rows("7:9").Delete Shift:=xlUp 'Zeilen 7-9 werden gelöscht
Application.ScreenUpdating = True
End Sub


Muster Datei

Gruß
fedjo

Hi!

Danke für die Antwort!
Aber diese Version zerschießt mir alle Formate und ist nicht schön.
Ich bräuchte für die erste Variante nur mehr Lehrzeilen.

Versuch es damit doch bitte noch mal.


Sub Zeiterfassung_Hauptgebäude()

Sheets("Import").Select
Range("A7").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

With Sheets("DB Zeiterfassung Hauptgeb.")
.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End With


Range("A7").Select
ActiveSheet.Paste
Sheets("Import").Select
Range("A1").Select


Application.ScreenUpdating = False
'fügt nach gleichen Datum leere Zeile ein
Dim lngZeile As Long ' Zeilenzähler
Dim bFirst As Boolean ' Flag für 1. Eintrag eines Artikels
lngZeile = 7 ' Start in Zeile 7
bFirst = True ' am Anfang haben wir immer einen 1. Datum
While Cells(lngZeile, 1) > "" ' Solange in der 1. Spalte der Zeile was steht
If bFirst Then ' falls 1. Eintrag
bFirst = False ' jetzt nicht mehr
Else ' nicht der 1. Eintrag
' Test auf Datumwechsel, d.h. der Wert in Spalte A ist identisch mit dem der vorherigen Zeile
If Cells(lngZeile, 1) = Cells(lngZeile - 1, 1) Then
Else ' unterschiedliche Datum
' neue Zeile einfügen
Rows(lngZeile).Insert
' Zeilenzähler anpassen
lngZeile = lngZeile + 1
' Leerzeile einfügen
Rows(lngZeile).Insert
' Jetzt haben wird wieder einen 1. Eintrag
bFirst = True
End If
End If
lngZeile = lngZeile + 1 ' eine Zeile weiter
Wend
End Sub


Gruss

Ines

Hallo Ines,
das Makro fügt jetzt vier Leerzeilen ein.
Für jede zusätzliche Leerzeile den Code ins Makro einfügen:
Rows(lngZeile).Insert
lngZeile = lngZeile + 1

Dein Makro "Zeiterfassung_Hauptgebäude" habe ich nicht getestet, da mir die Vorlage dazu fehlt. Am Anfang deines Makros solltest du den Tabellenwechsel mit (Application.ScreenUpdating = False) verhindern und soweit wie möglich Select vermeiden.
Vielleicht kannst du ja eine Musterdatei uploaden: www.file-upload.net und den Link ins Forum stellen.

Sub Makro1()
Application.ScreenUpdating = False
Dim lngZeile As Long
Dim bFirst As Boolean
lngZeile = 7
bFirst = True
While Cells(lngZeile, 1) > ""
If bFirst Then
bFirst = False
Else '
If Cells(lngZeile, 1) = Cells(lngZeile - 1, 1) Then
Else
Rows(lngZeile).Insert
lngZeile = lngZeile + 1
Rows(lngZeile).Insert
lngZeile = lngZeile + 1
Rows(lngZeile).Insert
lngZeile = lngZeile + 1
Rows(lngZeile).Insert
bFirst = True
End If
End If
lngZeile = lngZeile + 1
Wend
End Sub

Gruß
fedjo

Prima!

Danke für die rasche Hilfe!

Gruss

Ines