Makro kürzen?
15.08.2004 20:40:51
Max
kann man dieses Makro auch kürzer Schreiben?
Das ganze geht von Zelle A120 bis A610.
Sub Drucken()
Application.ScreenUpdating = False
If [a120] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$120:$X$128"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a130] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$130:$X$138"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a140] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$140:$X$148"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a150] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$150:$X$158"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a160] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$160:$X$168"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a170] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$170:$X$178"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a180] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$180:$X$188"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a190] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$190:$X$198"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a200] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$200:$X$208"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a210] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$210:$X$218"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a220] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$220:$X$228"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a230] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$230:$X$238"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a240] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$240:$X$248"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a250] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$250:$X$258"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a260] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$260:$X$268"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a270] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$270:$X$278"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a280] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$280:$X$288"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a290] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$290:$X$298"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a300] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$300:$X$308"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a310] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$310:$X$318"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a320] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$320:$X$328"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a330] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$330:$X$338"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a340] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$340:$X$348"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a350] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$350:$X$358"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a360] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$360:$X$368"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a370] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$370:$X$378"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a380] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$380:$X$388"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a390] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$390:$X$398"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If [a400] = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$400:$X$408"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
Application.ScreenUpdating = True
End
Sub
Max M.