title image


Smiley Re: Hier mal ein Makro zum Testen
Hallo, ich noch mal.

Das Makro läuft jetzt zwar, doch es passiert nichts. Ich habe das bestimmt falsch reinkopiert. Kanns du noch mal schauen.



Vielen Dank



Sub testen()

Dim i1 As Long, i2 As Long

Dim lastRow As Long

Dim s1 As Worksheet

Dim s3 As Worksheet

Set s1 = ActiveWorkbook.Sheets("Europlus")

Set s3 = ActiveWorkbook.Sheets("EUROPLUS (2)")



i2 = 1

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

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)



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

End If

Dim hpb As HPageBreak

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



Next i1



End Sub



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: