Tabelle reinigen

[elamigo]

Guten Tag zusammen,

anbei eine Tabelle, in dieser möchte ich die leeren Zeilen nach oben schieben oder kopieren. Es soll vor allem nichts gelöscht werden an Zeilen. Ich hatte schon einen Code der mal funktiniert hat, aber es nicht mehr tut. Vllt muss da jemand nur wenig korrigieren. Das Ganze soll in ein Worksheet_Activate Event kommen, aber mir reicht erstmal der Code. 

Hier was ich schon habe, aber leider nicht so perfekt funktioniert:

Code:

Private Sub Worksheet_Activate()
Dim arrWerteB(1 To 36, 0) As Variant, arrWerteD(1 To 36, 0) As Variant
Dim i As Long, b As Long, d As Long
Sheets("vor Makro").Unprotect ("123")
b = 1
d = 1
For i = 9 To 36
   If Cells(i, 2) <> "" Then
      arrWerteB(b, 0) = Cells(i, 2).Value
      b = b + 1
   End If
   If Cells(i, 4) <> "" Then
      arrWerteD(d, 0) = Cells(i, 4).Value
      d = d + 1
   End If
  
Next i
Range("B11:B36").Value = arrWerteB
Range("D11:D36").Value = arrWerteD

Sheets("vor Makro").Protect ("123"), DrawingObjects:=True, Contents:=True, Scenarios:=True _
      , AllowFormattingCells:=True, AllowFormattingColumns:=True, _
       AllowFormattingRows:=True, AllowSorting:=True, AllowFiltering:=True
       
End Sub

[Kuwer]

Hallo,

Private Sub Worksheet_Activate()

  Range("B9:B37").Sort Key1:=Range("B9"), Order1:=xlAscending, Header:=xlNo

  Range("D9:D37").Sort Key1:=Range("D9"), Order1:=xlAscending, Header:=xlNo

End Sub

Gruß Uwe

[elamigo]

danke dir Uwe, sieht schon mal sehr gut aus.

allerdings bekomme ich das wenn ich auf das Tabellenblatt wechsel ohne vorher etwas neu hinein zu kopieren.

---

konnte das Bild leider nicht mehr nachträglich einfügen