title image


Smiley Re: Hier mal ein Makro zum Testen
Hallo,



irgendwie hast du den alten Teil in die Schleife des 2. Teil geschrieben.

Oder irgendwas verschoben.



hier noch mal neu zusammengesetzt.

Ich hoffe es geht.







      

Dim i1 As Long, i2 As Long

Dim lastRow As Long

Dim s1 As Worksheet

Dim s3 As Worksheet

Dim hpb As HPageBreak

Set s1 = ActiveWorkbook.Sheets(1)

Set s3 = ActiveWorkbook.Sheets(3)



i2 = 1

lastRow = s1.Cells(Rows.Count, 1).End(xlUp).Row



For i1 = 1 To lastRow

    Select Case s1.Cells(i1, 1).Value

        Case 4, 5, 35

            Select Case s1.Cells(i1, 2).Value

                Case 24 To 32

                    s3.Rows(i2).Value = s1.Rows(i1).Value

                    i2 = i2 + 1

        End Select

    End Select

Next i1



s3.Activate

    s3.Columns("A:L").Sort Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("B1") _

        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _

        False, Orientation:=xlTopToBottom



lastRow = s3.Cells(Rows.Count, 1).End(xlUp).Row



    ActiveWindow.View = xlPageBreakPreview

    ActiveWindow.Zoom = 100



For Each hpb In s3.HPageBreaks

    hpb.Delete

Next hpb



For i1 = 2 To lastRow

    If s3.Cells(i1, 1).Value <> s3.Cells(i1 - 1, 1).Value Or s3.Cells(i1, 2).Value <> s3.Cells(i1 - 1, 2).Value Then

        s3.HPageBreaks.Add s3.Cells(i1, 1)

    End If

Next i1

 



Code eingefügt mit Syntaxhighlighter 3.0




Gruss Klapperstorch
----------------------------------------------------
Aus Felern lernt man oder...
Edjucashon isnt woerking

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: