Udskriv flere sider

Et bud:
Hvis det er i bredden du mener, skal du udvide kolonnen i dit range("h").

Nej det er det desværre ikke! Det er længden derfor har jeg sat den til a1000!

Jeg kunne forestille mig en løsning hvor en tæller angav et område ved de første 50 sider og et andet ved liner over 50!

denne udvidelse virker hos mig

Sub Marker()

Dim rk

Range("a1:a56").Select
For Each rk In Selection
If rk <> "" Then
Range("a" & rk.Row, Range("c" & rk.Row)).Interior.ColorIndex = 6
ActiveSheet.PrintOut 'PrintPreview ' PrintOut
Range("a" & rk.Row, Range("c" & rk.Row)).Interior.ColorIndex = xlNone
End If
Next

Range(Range("a57").End(xlDown), Range("a65536").End(xlUp)).Select
For Each rk In Selection
If rk <> "" Then
Range("a" & rk.Row, Range("c" & rk.Row)).Interior.ColorIndex = 6
ActiveSheet.PrintOut 'PrintPreview ' PrintOut
Range("a" & rk.Row, Range("c" & rk.Row)).Interior.ColorIndex = xlNone
End If
Next

End Sub

denne er vist bedre:

Sub Marker()

Dim rk

Range("a1:a56").Select
For Each rk In Selection
If rk <> "" Then
Range("a" & rk.Row, Range("c" & rk.Row)).Interior.ColorIndex = 6
ActiveSheet.PrintPreview ' PrintOut
Range("a" & rk.Row, Range("c" & rk.Row)).Interior.ColorIndex = xlNone
End If
Next

'Range(Range("a57").End(xlDown), Range("a65536").End(xlUp)).Select
Range("a57:a112").Select
For Each rk In Selection
If rk <> "" Then
Range("a" & rk.Row, Range("c" & rk.Row)).Interior.ColorIndex = 6
ActiveSheet.PrintPreview ' PrintOut
Range("a" & rk.Row, Range("c" & rk.Row)).Interior.ColorIndex = xlNone
End If
Next

End Sub

ret evt a57 og a112 ind til dine sideskift

Hmm! Jeg får skrevet alle sider ud på engang! Jeg ønsker kun at skrive den side ud hvor der er en markering!
Jeg har løst den med inspiration fra Excelent's løsning:

Sub Marker()

Dim rk

Range("a1:a10").Select
For Each rk In Selection
If rk <> "" Then
Range("a" & rk.Row, Range("c" & rk.Row)).Interior.ColorIndex = 6
Worksheets("Ark1").PageSetup.PrintArea = "$A$1:$C$10"
ActiveSheet.PrintPreview ' PrintOut
Range("a" & rk.Row, Range("c" & rk.Row)).Interior.ColorIndex = xlNone
End If
Next

Range("a11:a14").Select
Worksheets("Ark1").PageSetup.PrintArea = "$A$11:$C$25"
For Each rk In Selection
If rk <> "" Then
Range("a" & rk.Row, Range("c" & rk.Row)).Interior.ColorIndex = 6
ActiveSheet.PrintPreview ' PrintOut
Range("a" & rk.Row, Range("c" & rk.Row)).Interior.ColorIndex = xlNone
End If
Next

End Sub

troede problemet var at side 2 ikke blev udskrevet!

Det er muligvis også mig der ikke har beskrevet problemet godt nok! Men dit forslag gave mig mulighed for selv finde frem til en løsning.

hmm

Hmmm hvordan er det jeg giver point!??

jeg kan lægge et svar, så kan du klikke på navnet og acceptere