Makro til udskrivning af rækker med indhold

Der er 30 point for svaret, men jeg ved bare ikke hvordan man ændrer pointtallet.

Sub Udskriv()
Dim Tom As Boolean, VL As Variant, T As Integer, R As Integer, I As Integer, AD As Integer
Application.ScreenUpdating = False
R = Range("A1").SpecialCells(xlLastCell).Row
AD = Range("A1").SpecialCells(xlLastCell).Column
For I = 1 To R
Tom = True
VL = Range(Cells(I, 1), Cells(I, AD)).Value
For T = 1 To AD
If VL(1, T) <> "" Then
Tom = False
Exit For
End If
Next

If Tom = True Then
Rows(I).EntireRow.Hidden = True
End If
Next
ActiveSheet.PrintOut
Cells.EntireRow.Hidden = False
Application.ScreenUpdating = True
End Sub

Tusind Tak
Det var lige hvad jeg havde brug for. Smider du to svar så jeg kan gi dig point ];-)

svar ;-))

Kabbak,

Jeg ville gerne give dig 30 point så kan du ikke sende et svar mere? Og selv om jeg har har trykket på Accepter knappen står dit nuværende svar ikke i accepteret status. Har du fået pointene????

du skal makere mit navn i boksen til venstre, 15 points er fint nok

Så lykkedes det. Mange tak for hjælpen ]:-)

selv tak

sæt disse 2  koder ind i ThisWorkbook modulet, så kan du se det ved vis udskrift

dobbeltklik på arket,når du kommer tilbage til arket, for at få dine skjulte rækker tilbage

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim Tom As Boolean, VL As Variant, T As Integer, R As Integer, I As Integer, AD As Integer

R = Range("A1").SpecialCells(xlLastCell).Row
AD = Range("A1").SpecialCells(xlLastCell).Column
For I = 1 To R
Tom = True
VL = Range(Cells(I, 1), Cells(I, AD)).Value
For T = 1 To AD
If VL(1, T) <> "" Then
Tom = False
Exit For
End If
Next

If Tom = True Then
Rows(I).EntireRow.Hidden = True
End If
Next

End Sub

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)


Cells.EntireRow.Hidden = False
End Sub

med disse 2 kan du faktisk godt skrive ud via din printer icon