title image


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



wenn alle Blätter ab Zeile 7 beginnen sollen + Blattschutz, dann so:



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("Tabelle1")

Set WkSh_O = Worksheets("Tabelle2")

Set WkSh_E = Worksheets("Tabelle3")



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("B" & 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("B" & 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





Gruß Peter

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: