I found multiple example for checking if a certain Sheet matches with one Name, but I need to check if one of the sheets in my Workbook (at least 70 Sheets) is a Item on a List ( at least 30 Names). If a Sheet matches, Convert to PDF, resume.

Sub PDFAlle2()
Dim w, ws As Worksheet
wsListe As String
Dim fName As String
wsListe = Sheets("Liste").Range("B3:B5")
On Error Resume Next
For Each ws In ActiveWorkbook.Sheets
If ws.Name = wsListe Then '<-- this obviously doesn't work
   With ActiveSheet
        
   fName = .Range("E2").Value & "Ausdruck"
   .ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
           "C:\PDFTest\" & fName, Quality:=xlQualityStandard, _
           IncludeDocProperties:=True, IgnorePrintAreas:=True, OpenAfterPublish:=False
 End With
End If
Next ws


End Sub

I'm sure someone can pull a solution out of his hat, but I have no Idea. It would be very nice if some could explain the solution in a few words or post a link with an explantion.

Thank you very much!

CodePudding user response：

Export Worksheets From a List to PDF

Option Explicit

Sub PDFAlle2()
    
    'Source
    Const sName As String = "Liste"
    Const sCol As String = "B"
    Const sfRow As Long = 3
    ' Destination
    Const diFolderPath As String = "C:\PDFTest\"
    Const dPDFNameAddress As String = "E2"
    Const dPDFSuffix As String = "Ausdruck"
    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Reference the range ('srg') containing the worksheet names.
    Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
    Dim slRow As Long: slRow = sws.Cells(sws.Rows.Count, sCol).End(xlUp).Row
    If slRow < sfRow Then
        Err.Raise 91, , "No data in column '" & sCol & "' starting from row " _
            & sfRow & "."
        Exit Sub
    End If
    Dim srg As Range
    Set srg = sws.Range(sws.Cells(sfRow, sCol), sws.Cells(slRow, sCol))
    
    ' Check the destination folderpath.
    Dim dFolderPath As String: dFolderPath = diFolderPath
    If Right(dFolderPath, 1) <> "\" Then dFolderPath = dFolderPath & "\"
    If Len(Dir(dFolderPath, vbDirectory)) = 0 Then
        Err.Raise 76, , "The path '" & dFolderPath & "' was not found."
        Exit Sub
    End If
    
    Dim sCell As Range
    Dim dws As Worksheet
    Dim dName As String
    Dim dCount As Long
    
    ' Loop through the cells with the names instead of the worksheets.
    For Each sCell In srg.Cells
        ' Attempt to reference the worksheet.
        On Error Resume Next
            Set dws = wb.Worksheets(CStr(sCell.Value))
        On Error GoTo 0
        If Not dws Is Nothing Then ' worksheet exists
            dName = vbNullString
            dName = CStr(dws.Range(dPDFNameAddress).Value)
            If Len(dName) > 0 Then ' cell is not empty
                dName = dName & dPDFSuffix
                dws.ExportAsFixedFormat Type:=xlTypePDF, _
                    Filename:=dFolderPath & dName, Quality:=xlQualityStandard, _
                    IncludeDocProperties:=True, IgnorePrintAreas:=True, _
                    OpenAfterPublish:=False
                dCount = dCount   1 ' counter for the message
            'Else ' cell is empty
            End If
            Set dws = Nothing
        'Else ' worksheet doesn't exist
        End If
    Next sCell
    
    MsgBox "Exported " & dCount & " worksheet(s).", vbInformation

End Sub

CodePudding user response：

You have two Lists:

1. list of sheets
2. list of filenames in the column.

Your current code loops through list of Sheets only...

Statement With ActiveSheet inside the loop is wrong, - as code not activating any other sheets and it is not recommended to activate them to make code run faster. From this mistake, next one accured.

fName = .Range("E2").Value & "Ausdruck statement is incorrect, it should specify the sheet, fName = ws.Range("E2").Value & "Ausdruck.

Also, wsListe in your code was used as range, but tried to be dimmed to a string.

Example:

Sub PDFAlle2()

Dim w, ws As Worksheet
Dim wsListe As Range 'Range not string
Dim fName As String

Set wsListe = ActiveWorkbook.Sheets("Liste").Range("B3:B5")

For Each ws In ActiveWorkbook.Sheets
    For Each v In wsListe
        If ws.Name = v Then
        fName = ws.Range("E2").Value & "Ausdruck" 'ws.Range not just .Range as code not sets any other sheet active, main sheet with file names stays active.
        ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "C:\PDFTest\" & fName, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=True, OpenAfterPublish:=False
        End If
    Next v
Next ws

End Sub