Hier der Code: einzeln funktionieren beide, nur in dem gesmtspeichernuinfo
Sub gesamtspeichernuinfo()
'es findet den Empfänger aus der Zelle nicht
EintragenDatenuebertragen0309
Blatt_versenden_PDF
End Sub
und hier der einzelne Code, wo der debugger to Range C18 hängt.
Sub Blatt_versenden_PDF()
Sheets("Blatt A").Select
Range("B3").Select
Selection.Copy
Sheets("Blatt B").Select
Range("B3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Blatt A").Select
Range("C6").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Blatt B").Select
Range("C6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Blatt A").Select
Range("C7").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Blatt B").Select
Range("C7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Blatt A").Select
Range("C8").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Blatt B").Select
Range("C8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Blatt A").Select
Range("C9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Blatt B").Select
Range("C9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Blatt A").Select
Range("B10").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Blatt B").Select
Range("B10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Blatt A").Select
Range("C13").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Blatt B").Select
Range("C13").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Blatt A").Select
Range("C14").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Blatt B").Select
Range("C14").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Blatt A").Select
Range("C17").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Blatt B").Select
Range("C17").Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Blatt A").Select
Range("C18").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Blatt B").Select
Range("C18").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Blatt A").Select
Range("H5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Blatt B").Select
Range("H5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Blatt A").Select
Range("H6").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Blatt B").Select
Range("H6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Blatt A").Select
Range("H7").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Blatt B").Select
Range("H7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Blatt A").Select
Range("H8").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Blatt B").Select
Range("H8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'neu
Sheets("Blatt A").Select
Range("F12").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Blatt B").Select
Range("H12").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Blatt A").Select
Range("F13").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Blatt B").Select
Range("H13").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Blatt B").Select
Range("F14").Select
Dim Nachricht As Object, OutApp As Object
Set OutApp = CreateObject("Outlook.Application")
Dim AWS As String, wksMail As Worksheet
Dim print_Range_old As String
Set wksMail = ActiveWorkbook.Sheets("Blatt B")
With wksMail
.Range("A1").Select
AWS = Environ("UserProfile") & "\Desktop\" & Format(Date, "YYMMDD") & "_" & Range("C6") & _
"Test" & ".pdf"
print_Range_old = .PageSetup.PrintArea
.PageSetup.PrintArea = "$A$1:$H$20"
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=AWS, Quality:=xlQualityStandard, _
Ignoreprintareas:=False
.PageSetup.PrintArea = print_Range_old
End With
Application.Visible = True
Sheets("Blatt B").Select
Set Nachricht = OutApp.CreateItem(0)
With Nachricht
.To = Range("C18")
.CC = ""
.Subject = "Übersichtsblatt Aktion " & Date & " " & Time
.Attachments.Add AWS
.Body = Range("C6") & "," & vbCrLf & vbCrLf & "anbei erhalten Sie das "
.Send
End With
Kill AWS
Set OutApp = Nothing
Set Nachricht = Nothing
MsgBox "Die Eingabe zur -" & Range("C6") & "- wurde erfolgreich gespeichert."
'Blatt A leeren
Sheets("Blatt A").Select
Range("C5").Select
Selection.ClearContents
'muss wahrscheinlich noch entsperrt werden
Sheets("Übersicht").Select
Range("X4").Value = "x"
Sheets("Mails versenden").Select
Range("X3").Value = "x"
'wieder ausblenden und speeren
'Startseite auswählen
Sheets("Eingabeformular").Select
Range("C5").Select
ActiveWorkbook.Save
End Sub