Filter kolom A op iedere code etc.

[Senso]

Filter kolom A op iedere code en geef de sheet de naam van deze code en sla elke sheet op als pdf. Voorbeeldbestand volgt. De gewenste code moet ik regel voor regel in de VBA kunnen ingeven omdat er te veel codes zijn.
Het gaat hier om een proef/test.
De sheetnaam is Maand
Het bestand staat in E:\test\
De doelmap van de pdf's is E:\test\
De sheetnaam van het filter wordt de code (vb > 8400)
De pdf krijgt ook de naam van de code

Onderstaande code is van internet. Je zou ook een box kunnen maken met de vraag de code in te voeren. Dus van welke code/filter wilt u een pdf?

VBA Macro: Filter, Create Sheets, and Save as PDF
Replace "Sheet1" with your source sheet name and adjust Field:=1 to the column index of your "code" (e.g., Column A = 1, Column B = 2).
vba

Sub FilterAndSaveAsPDF()
    Dim ws As Worksheet, tempWs As Worksheet
    Dim lastRow As Long, i As Long
    Dim uniqueCodes As Collection
    Dim codeValue As Variant
    Dim savePath As String
 
    ' SETTINGS: Change these as needed
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Your source sheet
    savePath = ThisWorkbook.Path & "\"    ' Saves in the same folder as the Excel file
 
    Set uniqueCodes = New Collection
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' Assumes codes are in Column A
 
    ' 1. Get Unique Codes
    On Error Resume Next
    For i = 2 To lastRow ' Assumes header is in Row 1
        uniqueCodes.Add ws.Cells(i, 1).Value, CStr(ws.Cells(i, 1).Value)
    Next i
    On Error GoTo 0
 
    ' 2. Loop Through Each Unique Code
    Application.ScreenUpdating = False
    For Each codeValue In uniqueCodes
        ' Filter and Copy
        ws.UsedRange.AutoFilter Field:=1, Criteria1:=codeValue
   
        ' Create temporary sheet
        Set tempWs = Sheets.Add(After:=Sheets(Sheets.Count))
        tempWs.Name = "Temp_" & Left(codeValue, 25) ' Sheet names limited to 31 chars
   
        ' Copy visible data to temporary sheet
        ws.UsedRange.SpecialCells(xlCellTypeVisible).Copy Destination:=tempWs.Range("A1")
   
        ' 3. Save as PDF
        tempWs.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=savePath & codeValue & ".pdf", _
            Quality:=xlQualityStandard
       
        ' Delete temporary sheet
        Application.DisplayAlerts = False
        tempWs.Delete
        Application.DisplayAlerts = True
    Next codeValue
 
    ' Clean up
    ws.AutoFilterMode = False
    Application.ScreenUpdating = True
    MsgBox "PDFs created successfully in: " & savePath
End Sub

 

[Senso]

Ik constateer nu dat de inhoud van de pdf totaal anders is dan de weergave op een sheet. Dus dan heeft het totaal geen zin.

 

[AHulpje]

Er gebeurt precies wat je wilt, maar heb je dit wel gezien?

' Assumes header is in Row 1