Doppelt PDFCreator komm nicht weiter

Sub DruckePDF()
StandartDrucker = Application.ActivePrinter
Application.ActivePrinter = "PDFCreator auf Ne01:"
Sheets("Abfragen").Select
BZelle = 9
For i = 1 To 5
BName = Sheets("PDF Druck").Range("B" & BZelle).Value
ActiveWindow.SelectedSheets.PrintOut From:=i, To:=i, Copies:=1, _
ActivePrinter:="PDFCreator auf Ne01:"PrintToFile:=True, Collate:=True, _
PrToFileName:="C:\Dokumente und Einstellungen\Testordner\" & BName & ".pdf"
BZelle = BZelle + 1
Next
Application.ActivePrinter = StandartDrucker
End Sub

Wenn es grundsätzlich nicht möglich ist dann bitte eine entsprechende Info.
Gruß Gast