title image


Smiley Re: Zeilen auf mehrer Tabellenblätter verteilen
Hallo Peter,



ein kleiner bug muß noch drin sein, ist erst jetzt aufgtreten. Kann ihn aber nicht finden.

Nach mehrmaliger Benutzung wird die Kopfzeile (Zeile1-6) auf den Tabellenblättern "Offene" und "Erledigte" gelöscht.



Noch einmal zusammengefasst sieht das im Moment so aus:



Public Sub Aufteilen()



Dim WkSh_Q As Worksheet

Dim WkSh_O As Worksheet

Dim WkSh_E As Worksheet

Dim lZeile_Q As Long

Dim lZeile_O As Long

Dim lZeile_E As Long



Application.ScreenUpdating = False



Set WkSh_Q = Worksheets("Alle Meldungen")

Set WkSh_O = Worksheets("Offene")

Set WkSh_E = Worksheets("Erledigte")



WkSh_O.Unprotect

WkSh_E.Unprotect



WkSh_O.Range("A7:Z" & WkSh_O.Range("A65536").End(xlUp).Row).ClearContents

WkSh_E.Range("A7:Z" & WkSh_E.Range("A65536").End(xlUp).Row).ClearContents



lZeile_O = 7

lZeile_E = 7



With WkSh_Q

For lZeile_Q = 7 To WkSh_Q.Range("A65536").End(xlUp).Row

If LCase(WkSh_Q.Range("J" & lZeile_Q).Value) = "offen" Then

WkSh_Q.Rows(lZeile_Q).Copy Destination:=WkSh_O.Rows(lZeile_O)

lZeile_O = lZeile_O + 1

ElseIf LCase(WkSh_Q.Range("J" & lZeile_Q).Value) = "erledigt" Then

WkSh_Q.Rows(lZeile_Q).Copy Destination:=WkSh_E.Rows(lZeile_E)

lZeile_E = lZeile_E + 1

End If

Next lZeile_Q

End With



WkSh_O.Protect

WkSh_E.Protect



Application.ScreenUpdating = True



End Sub





Tabellenblatt "Alle Meldungen" - Code:



Private Sub Worksheet_Change(ByVal Target As Range)



If Target.Column = 2 And Target.Row > 0 And Target.Row < 2000 Then

If LCase(Target.Value) = "offen" Or _

LCase(Target.Value) = "erledigt" Then

Call Aufteilen

End If

End If



End Sub



Tabellenblatt "Offene" und "Erledigte" - Code:



Private Sub Worksheet_Activate()

Call Aufteilen

End Sub



Vielleicht siehst Du auf Anhieb woran es liegt.



Gruß

Bernd

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: