Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Tabelle reinigen
#1
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


Angehängte Dateien
.xlsx   CF Forum.xlsx (Größe: 9,84 KB / Downloads: 3)
Antwortento top
#2
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
Antwortento top
#3
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


Angehängte Dateien Thumbnail(s)
   
Antwortento top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste