Hallo Yunnan,
Mein Problem:
Ich habe jeden Monat mehrere Listen (versch. Excel TAB’s) von
Personen (z.B. Zeile 14), denen Daten in den nachfolgenden
Spalten zugeordnet sind. Insgesamt eine Liste von ungefähr 600
Zeilen. Um es übersichtlicher zu gestalten, soll nach jedem
Ende eines Personenblocks (z.B. Schmitt) eine Leerzeile
eingefügt werden.
ohne genaue Kenntnis des Tabellenaufbaus kann ich so ein Makro nicht erstellen. Hier mal 2 Makrobeispiele. Leider hatte ich ein Problem mit den Tags zur Darstellung von Codes, so dass die Leezeichen zur besseren Darstellung der Code-Struktur fehlen.
Gruß
Franz
Sub LeerZeileEinfuegen()
'Komplette Liste abarbeiten
Dim Zeile As Long, wks As Worksheet
Const Zeile1 = 2 '1. Zeile mit einem Namen
Const Spalte As Long = 1 'Nummer der Spalte mit den Namen - hier Spalte A (1)
Set wks = ActiveSheet
With wks
'Namen von vorletzter Zeile bis zur 1. Namenszeile vergleichen und bei Namenswechsel _
eine Leerzeile einfügen
Application.ScreenUpdating = False
For Zeile = .Cells(.Rows.Count, Spalte).End(xlUp).Row - 1 To Zeile1 Step -1
If Not .Cells(Zeile + 1, Spalte) = .Cells(Zeile, Spalte) Then
.Cells(Zeile + 1, Spalte).EntireRow.Insert shift:=xlShiftDown
End If
Next
Application.ScreenUpdating = True
End With
End Sub
Sub LeerZeileEinfuegenName()
'Einzelnen Namen suchen und Leerzeile einfügen
Dim Zeile As Long, wks As Worksheet, vName
Const Zeile1 = 2 '1. Zeile mit einem Namen
Const Spalte As Long = 1 'Nummer der Spalte mit den Namen - hier Spalte A (1)
vName = InputBox(„Bitte Name eingeben“, „Leerzeile nach Name einfüen“)
If vName = „“ Then GoTo Beenden
Set wks = ActiveSheet
With wks
'Namen von vorletzter Zeile bis zur 1. Namenszeile vergleichen und bei Namenswechsel _
eine Leerzeile einfügen
For Zeile = .Cells(.Rows.Count, Spalte).End(xlUp).Row - 1 To Zeile1 Step -1
If .Cells(Zeile, Spalte) = vName Then
.Cells(Zeile + 1, Spalte).EntireRow.Insert shift:=xlShiftDown
Exit For
End If
If Zeile = Zeile1 Then
MsgBox „Name „““ & vName & „“" nicht gefunden", vbInformation + vbOKOnly, _
„Leerzeile nach Name einfüen“
End If
Next
End With
Beenden:
End Sub