Ich danke Euch für Eure Mithilfe
Beste Grüsse
Sub Lohn_Uebertragen()
Dim vntFile As Variant
vntFile = Application.GetSaveAsFilename(Range("Q1").Value & "\" & ActiveSheet.Name & _
Range("N6").Value & ".pdf", "PDF Dateien (*.pdf), *.pdf", Title:="Als PDF Speichern")
If vntFile False Then
ActiveSheet.Range("B1:J58").ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=vntFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=Fals, _
OpenAfterPublish:=Fals
End If
vntFile = Application.GetSaveAsFilename(Range("Q1").Value & "\" & ActiveSheet.Name & _
Range("N7").Value & ".pdf", "PDF Dateien (*.pdf), *.pdf", Title:="Als PDF Speichern")
If vntFile False Then
ActiveSheet.Range("G1:J58").ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=vntFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=Fals, _
OpenAfterPublish:=Fals
End If
Sheets("Tabelle1").Select
Columns("C:C").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("Roger Meier").Select
Range("N4:N32").Select
Selection.Copy
Sheets("Tabelle1").Select
Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("C:C").EntireColumn.AutoFit
Sheets("Roger Meier").Select
Application.CutCopyMode = False
Range("D19").Select
End Sub