Print sheets depend on cell value

[KlausW]

Hi everyone

I use this VBA code to print tabs, except those in the VBA code. Now I would like to make it so that the VBA code only prints from the number in cell L1. Example I write 11 in L1, only tabs 11, 12, 13,14 up to 30 should be printed, if it says 2 in L1 it should only be tabs 2, 3,4,,5 up to 30. Of course there are not the same number of days in all months so some will also have 31.
I hope this makes sense, and some can help.
All help will be appreciated.

Best regards
Klaus W

Sub Rektangelafrundedehjørner1_Klik()

Dim ws As Worksheet
 For Each ws In ActiveWorkbook.Worksheets
  If ws.Visible = True Then
  If ws.Name <> "Ark1" And _
    ws.Name <> "Stamdata" And _
    ws.Name <> "Ialt" And _
    ws.Name <> "Til BM" And _
    ws.Name <> "PRB" Then
       With ws.PageSetup
        .PrintArea = "a1:r20" ' USE YOUR PRINTAREA
        .Zoom = False
        .FitToPagesTall = 1
        .FitToPagesWide = 1
       End With
       ws.PrintOut
   End If
  End If
 Next ws

End Sub

 

[ebea]

I made a new code, which hopefully should work.

Sub Rektangelafrundedehjørner1_Klik()

    Dim startArk As Integer
    Dim i As Integer
    Dim ws As Worksheet
    
    Application.ScreenUpdating = False
    startArk = Worksheets("Stamdata").Range("L1").Value

    For i = startArk To 30
        On Error Resume Next 'Sikrer, at koden fortsætter, hvis arket ikke findes
        Set ws = Worksheets(CStr(i)) 'Skift til arket med nummeret
        On Error GoTo 0

        If Not ws Is Nothing Then
            ws.PageSetup.PrintArea = "A1:R20" 'Det definerede printområde
            ws.PrintOut
        End If
        Set ws = Nothing
    Next i
    Application.ScreenUpdating = True
End Sub

 

[KlausW]

If the value in cell L1 is already numeric, just change this line in my VBA code:

j = CInt(fst)

to this:

j = fst

 

[KlausW]

I made a new code, which hopefully should work.

Sub Rektangelafrundedehjørner1_Klik()

    Dim startArk As Integer
    Dim i As Integer
    Dim ws As Worksheet
   
    Application.ScreenUpdating = False
    startArk = Worksheets("Stamdata").Range("L1").Value

    For i = startArk To 30
        On Error Resume Next 'Sikrer, at koden fortsætter, hvis arket ikke findes
        Set ws = Worksheets(CStr(i)) 'Skift til arket med nummeret
        On Error GoTo 0

        If Not ws Is Nothing Then
            ws.PageSetup.PrintArea = "A1:R20" 'Det definerede printområde
            ws.PrintOut
        End If
        Set ws = Nothing
    Next i
    Application.ScreenUpdating = True
End Sub

I made a new code, which hopefully should work.

Sub Rektangelafrundedehjørner1_Klik()

    Dim startArk As Integer
    Dim i As Integer
    Dim ws As Worksheet
   
    Application.ScreenUpdating = False
    startArk = Worksheets("Stamdata").Range("L1").Value

    For i = startArk To 30
        On Error Resume Next 'Sikrer, at koden fortsætter, hvis arket ikke findes
        Set ws = Worksheets(CStr(i)) 'Skift til arket med nummeret
        On Error GoTo 0

        If Not ws Is Nothing Then
            ws.PageSetup.PrintArea = "A1:R20" 'Det definerede printområde
            ws.PrintOut
        End If
        Set ws = Nothing
    Next i
    Application.ScreenUpdating = True
End Sub

Dear ebea It works as it should, many thanks, Best Regards Klaus W