AW: Wie kann ich eine Tabelle aus Blatt 2 über ein Makro, welches unter Blatt 1 laufen muss, als .pdf speichern?
02.02.2020 21:19:41
Werner
Hallo,
teste mal:
Option Explicit
Sub UEBERTRAG_DATEN_NEUAUFNAHME_IN_TABELLE()
Dim ws_Quelle As Worksheet, lng_letzte_zeile As Long, i As Long
Set wsQuelle = ThisWorkbook.Worksheets("ERFASSUNGSFORMULAR")
Application.ScreenUpdating = False
'Daten aus ERFASSUNGSFORMULAR in KLIENTENDATENBANK eintragen
With ThisWorkbook.Worksheets("KLIENTENDATENBANK")
lng_letzte_zeile = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
For i = 2 To 10
.Cells(lng_letzte_zeile, i) = ws_Quelle.Cells(51, i + 2)
Next i
.Cells(lng_letzte_zeile, 9) = ws_Quelle.Cells(51, 59)
.Cells(lng_letzte_zeile, 10) = ws_Quelle.Cells(51, 60)
For i = 11 To 33
.Cells(lng_letzte_zeile, i) = ws_Quelle.Cells(51, i)
Next i
.Cells(lng_letzte_zeile, 63) = ws_Quelle.Cells(51, 58)
.Cells(lng_letzte_zeile, 35) = ws_Quelle.Cells(51, 34)
.Cells(lng_letzte_zeile, 36) = ws_Quelle.Cells(51, 35)
.Cells(lng_letzte_zeile, 37) = ws_Quelle.Cells(53, 34)
.Cells(lng_letzte_zeile, 38) = ws_Quelle.Cells(53, 35)
For i = 39 To 42
.Cells(lng_letzte_zeile, 39) = ws_Quelle.Cells(51, i - 3)
Next i
For i = 44 To 62
.Cells(lng_letzte_zeile, 44) = ws_Quelle.Cells(51, i - 4)
Next i
'Daten aus ERFASSUNGSFORMULAR in KLIENTENDATENBANK eintragen
.Cells(lng_letzte_zeile + 2, 2) = ws_Quelle.Cells(51, 5)
.Cells(lng_letzte_zeile + 2, 3) = ws_Quelle.Cells(51, 33)
.Cells(lng_letzte_zeile + 2, 21) = ws_Quelle.Cells(51, 2)
End With
'DRUCKERFASSUNGSFORMULAR ausdrucken
With ThisWorkbook.Worksheets("DRUCKERFASSUNGSFORMULAR")
.PageSetup.PrintArea = "$c$1:$p$60"
.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
.ExportAsFixedFormat xlTypePDF, Worksheets("Cockpit").Range("F52").Text _
& "\" & Worksheets("Cockpit").Range("F53").Text
End With
'ERFASSUNGSFORMULAR leeren
With ThisWorkbook.Worksheets("ERFASSUNGSFORMULAR")
.Unprotect
Union(.Range("L15,N13:P13,N15:P15,N19:P19,N21:P21,R7:T7,R9:T9,R13:W13," _
& "R15:W15,T19,T21,T23,T25,D1,H3,D7:F7,D9:F9,D13:F13,D15:F15,D19," _
& "D21,D23,D25,D27,D29,B33:P36,H13,H15,H19,H21,H23,H25"), .Range("H27,H29," _
& "J7,J9,J19:L19,J21:L21,J23:L23,J25:L25,J27:L27,J29:L29,L7,L9,L13")).ClearContents
.Range("H3").Select
.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
Set ws_Quelle = Nothing
End Sub
Beim Schreiben der Daten habe ich durch Schleifen den Code etwas eingekürzt.
Unklar ist mir allerdings weshalb du beim Leeren vom Blatt "Erfassungsformular" den Blattschutz aufhebst und wieder setzt. Wenn du nur die Zellen leerst, in denen du vorher die Daten eingegeben hast, dann können die ja nicht gesperrt sein, sonst hättest du da ja auch keine Daten eingeben können. Also ist mir unklar weshalb du den Blattschutz raus nimmst und dann wieder rein machst.
Gruß Werner
