Hallo Miteinander
ich habe ein problem mit folgender prozedur:
Sie soll versch. Druckbereich auf eine Seite drucken.
Er hängt bei mir jedoch jedes mal bei der find methode fest....
Sub MehrBereichsDruck()
Dim TB1 As Worksheet, TB2 As Worksheet
Dim SA As Range
Dim i, y
Application.ScreenUpdating = False
Set TB1 = ActiveSheet
Set TB2 = Worksheets.Add
TB1.Select
i = 1: y = 1
For Each SA In Selection.Areas
MsgBox Selection.Areas(1).Address
MsgBox Selection.Areas(1).Parent.Name
TB2.Cells(i, 1) = "Bereich Nr. " & y
i = i + 1
SA.Copy
TB2.Cells(i, 1).PasteSpecial Paste:=xlValues
i = TB2.Cells.Find("*", "A1", , , xlByRows, xlPrevious).Row + 2 ' hier bleibt er hängen!!!
y = y + 1
Next SA
Unload UserForm1
TB2.PrintPreview
Application.DisplayAlerts = False
TB2.Delete
Application.DisplayAlerts = True
End Sub
kann mir jemand helfen?
gruss rolf