Tabbladen per twee opslaan als PDF

[LindaVelde]

Ik heb, mede dankzij deze forum, het voor elkaar gekregen om een macro te maken waarmee ik automatisch tabbladen separaat kan opslaan als pdf.
Maar nu zou ik hetzelfde willen maar dan per twee tabbladen.
Daarmee bedoel ik dat ik graag zou willen dat tabblad 1+2 1 pdf worden, dan 3+4, dan 5+6 enz
En om het nog makkelijker te maken wil ik de info voor de bestandsnaam uit de oneven bladen halen (1, 3, 5 enz)

Is dat mogelijk?

Ik gebruik deze code voor het separaat opslaan als pdf

Private Sub CommandButton1_Click()
Dim i As Long, fName As String, foutmelding As String
For i = 4 To Sheets.Count
    With Sheets(i)
        If .Range("B1") = vbNullString Or .Range("A1") = vbNullString Or .Range("B9") = vbNullString Or .Range("C1") = vbNullString Then foutmelding = _
                foutmelding & vbLf & Sheets(i).Name: GoTo vervolg
        fName = "M:\Facturatie\Herinneringen\2016\8 augustus\" & .Range("B1") & " " & .Range("A1") & " herinnering nr " & .Range("C1") & " " & .Range("C9")
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=fName & ".pdf", Quality _
        :=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    End With
vervolg:
Next
If foutmelding <> "" Then MsgBox "Volgend(e) werkblad(en) zijn niet opgeslagen" & vbLf & _
        "wegens onvoldoende parameters !" & foutmelding
End Sub

 

[Timshel]

Probeer deze:

Sub tsh()
    Dim Br(1)
    Dim i As Long
    Dim fName As String, Foutmelding As String
    
    For i = 4 To Sheets.Count Step 2
        With Sheets(i)
            If .Range("B1") = "" Or .Range("A1") = "" Or .Range("B9") = "" Or .Range("C1") = "" Then
                Foutmelding = Foutmelding & vbLf & .Name
            Else
                fName = "M:\Facturatie\Herinneringen\2016\8 augustus\" & .Range("B1") & " " & .Range("A1") & " herinnering nr " & .Range("C1") & " " & .Range("C9")
                Br(0) = .Name
                Br(1) = Sheets(i + 1).Name
                Sheets(Br).Select
                ActiveSheet.ExportAsFixedFormat xlTypePDF, fName & ".pdf"
            End If
        End With
    Next
    If Foutmelding <> "" Then MsgBox "Volgend(e) werkblad(en) zijn niet opgeslagen" & vbLf & _
        "wegens onvoldoende parameters: " & Foutmelding
End Sub

 

[LindaVelde]

Ik krijg een compileer fout:
Else zonder IF

 

[LindaVelde]

Ik heb er nu dit van gemaakt:

Private Sub CommandButton1_Click()
Dim Br(1)
    Dim i As Long
    Dim fName As String, Foutmelding As String
    For i = 4 To Sheets.Count Step 2
    With Sheets(i)
    If .Range("B1") = "" Or .Range("A1") = "" Or .Range("B9") = "" Or .Range("C1") = "" Then Foutmelding = Foutmelding & vbLf & .Name: GoTo vervolg
        fName = "M:\Facturatie\Herinneringen\2016\8 augustus\" & .Range("B1") & " " & .Range("A1") & " herinnering nr " & .Range("C1") & " " & .Range("C9")
        Br(0) = .Name
        Br(1) = Sheets(i + 1).Name
        Sheets(Br).Select
        ActiveSheet.ExportAsFixedFormat xlTypePDF, fName & ".pdf"
    End With
vervolg:
Next
If foutmelding <> "" Then MsgBox "Volgend(e) werkblad(en) zijn niet opgeslagen" & vbLf & _
        "wegens onvoldoende parameters !" & foutmelding
End Sub

Dit werkt!

Thanks!

 

[edmoor]

De code van Timshel is goed dus dan heb je deze niet goed overgenomen of ergens tussen geplakt waardoor het niet meer klopt. Maar de melding lijkt me duidelijk, er wordt ergens een If gebruikt zonder de bijbehorende End If. Kijk dat dus eens na.

 

[LindaVelde]

Dat snap ik Edmoor.
Maar ik zag niet waar het zat.
Daarom heb ik gekozen om mijn eigen code uit te breiden met de code van Timshel en het werkt.

Super bedankt Timshel.
Dit scheelt mij echt uren van selecteren en Opslaan als.