Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
468to472
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
468to472
468to472
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Makro kürzen???

Makro kürzen?
15.08.2004 20:40:51
Max
Hallo Leute,
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.

		

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro kürzen?
Ulf
Ungestet, sollte aber funktionieren:
Option Explicit

Sub drucken_Step10()
Dim z As Long
For z = 120 To 400 Step 10
If Cells(z, 1) = "x" Then
ActiveSheet.PageSetup.PrintArea = "$B$" & z & ":$X$" & z + 8
ActiveSheet.PrintOut Copies:=1, Collate:=True
End If
End Sub

Ulf
AW: Makro kürzen?
Max
Hallo Ulf,
danke für deine Antwort.
Es funktioniert, habe nur noch Next z hinzugefügt.
Gruß Max.
AW: Makro kürzen?
15.08.2004 20:54:59
Klaus-Dieter
Hallo Max,
kurz genug?

Sub test()
Dim s As Integer
For s = 120 To 610 Step 10
If Cells(s, 1) = "x" Then
Range("B" & s, "X" & s + 8).PrintOut Copies:=1, Collate:=True
End If
Next s
End Sub

Gruß Klaus-Dieter

Anzeige
AW: Makro kürzen?
Max
Hallo Klaus Dieter,
danke, auch dein verkürztes Makro funktioniert.
Gruß Max.
Was hattest du erwartet? ;-) o.T.
15.08.2004 21:26:22
Klaus-Dieter

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige