|  
                                             
	Das führt zum gleichen Ergebnis. Die Selection geht ja über vielerlei Wege und ist auch immer korrekt, allerdings arbeitet Exportasfixedformat die Selections wahrscheinlich nacheinander ab und springt dann immer auf die nächste Seite für jede Spalte. 
	Ich habe es jetzt über eine temp-sheet gelöst. Anbei der Code; auch etwas mehr aufgeräumt. 
	Eine kurze Frage, wie unselektiere ich im SourceSheet die Spalten? Nach dem Ausführen des Makros sind die benötigten Spalten noch selektiert. Ist zwar kein Problem aber würde schöner aussehen wenn da nichts selektiert wärer oder der Cursor in A1 steht. 
	  
Sub Export_and_Print_1()
 
Application.PrintCommunication = True
 
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim strTmpsheet As String
Dim strSource As String
Dim strSourceRange As String
Dim myFile As Variant
On Error GoTo errHandler
 
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
 
'----- set source & temp sheet-----
strSource = "Tabelle1"
strSourceRange = "A:A,D:D,F:F,G:G,H:H,J:J"
strTmpsheet = "temp-to-print.ttp"
 
strTime = Format(Now(), "yyyymmdd\_hhmmss")
 
'----- get active workbook folder, if saved -----
strPath = wbA.Path
If strPath = "" Then
  strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
 
'----- replace spaces and periods in sheet name -----
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")
 
'----- create default name for saving file -----
strFile = strName & "_" & strTime & ".pdf"
strPathFile = strPath & strFile
 
'----- select folder & let user customize file name -----
myFile = Application.GetSaveAsFilename _
    (InitialFileName:=strPathFile, _
        FileFilter:="PDF Files (*.pdf), *.pdf", _
        Title:="Bitte wählen Sie den Speicherort.")
 
Application.DisplayAlerts = False
Application.ScreenUpdating = False
 
'---- add temp sheet and setting up the paper -----
ThisWorkbook.Sheets.Add.Name = strTmpsheet
Application.PrintCommunication = False
   
    With ActiveSheet.PageSetup
        .Orientation = xlLandscape
        .Zoom = False
        .FitToPagesWide = 1
    End With
 
'----- going to source and getting the data -----
Sheets(strSource).Select
If myFile <> "False" Then
        Range(strSourceRange).Select
        Selection.Copy
        Sheets(strTmpsheet).Select
        ActiveSheet.Paste
       
'----- make the PDF -----
        Sheets(strTmpsheet).ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=myFile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=True
 
'----- confirmation message with file info -----
    MsgBox "PDF wurde erfolgreich erstellt: " _
      & vbCrLf _
      & myFile
    ThisWorkbook.Sheets(strTmpsheet).Delete
End If
 
'----- exit handler -----
exitHandler:
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Exit Sub
errHandler:
    MsgBox "PDF konnte nicht erstellt werden!"
    Resume exitHandler
End Sub
	  
     |