Thema Datum  Von Nutzer Rating
Antwort
Rot VBA Excel Code mit Variablen vereinfachen - 2 if Abfragen
 12.05.2018 15:48:12 Steven
NotSolved
12.05.2018 18:54:12 AlterDresdner
NotSolved
12.05.2018 19:03:55 Gast26575
NotSolved
12.05.2018 19:02:00 AlterDresdner
NotSolved
12.05.2018 19:07:15 Gast95208
NotSolved
12.05.2018 23:55:13 Gast48150
NotSolved
13.05.2018 15:00:32 Gast11923
NotSolved

Ansicht des Beitrags:
Von:
Steven		 Datum:
12.05.2018 15:48:12		 Views:
1079		 Rating:
     
Antwort:
  Ja
Thema:
VBA Excel Code mit Variablen vereinfachen - 2 if Abfragen

Hallo Ihr Experten,
Kann mir jemand den Code (läuft OK) nur vereinfachen/kürzen?
Es wird eine pdf-Datei erzeugt und gleichzeitig je nach 2 Abfragen auf unterschiedliche Bereiche Werte kopiert.

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
Sub aktivesBlattToPdf()
Dim Quelle As Worksheet
Dim Ziel As Worksheet
 
Set Quelle = Sheets("PRÄ")
Set Ziel = Sheets("STATISTIK")
 
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "" & Quelle.Name & "." & Quelle.Range("D3").Value & "." & Format(Date, "YY.") & Range("E2") & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
 
Ziel.Unprotect Password:="pass"
 
With Ziel
Quelle.Range("P8:P107").Copy
    Select Case Quelle.Range("E2").Value And Quelle.Range("D3") = Tabelle15.Name
        Case 1:
            .Range("C4").PasteSpecial Paste:=xlValues
        Case 2:
            .Range("D4").PasteSpecial Paste:=xlValues
        Case 3:
            .Range("E4").PasteSpecial Paste:=xlValues
        Case 4:
            .Range("F4").PasteSpecial Paste:=xlValues
        Case 5:
            .Range("G4").PasteSpecial Paste:=xlValues
        Case 6:
            .Range("H4").PasteSpecial Paste:=xlValues
        Case 7:
            .Range("I4").PasteSpecial Paste:=xlValues
        Case 8:
            .Range("J4").PasteSpecial Paste:=xlValues
        Case 9:
            .Range("K4").PasteSpecial Paste:=xlValues
        Case 10:
            .Range("L4").PasteSpecial Paste:=xlValues
        Case 11:
            .Range("M4").PasteSpecial Paste:=xlValues
        Case 12:
            .Range("N4").PasteSpecial Paste:=xlValues
    End Select
End With
 
With Ziel
Quelle.Range("P8:P107").Copy
    Select Case Quelle.Range("E2").Value And ActiveSheet.Range("D3") = Tabelle16.Name
        Case 1:
            .Range("S4").PasteSpecial Paste:=xlValues
        Case 2:
            .Range("T4").PasteSpecial Paste:=xlValues
        Case 3:
            .Range("U4").PasteSpecial Paste:=xlValues
        Case 4:
            .Range("V4").PasteSpecial Paste:=xlValues
        Case 5:
            .Range("W4").PasteSpecial Paste:=xlValues
        Case 6:
            .Range("X4").PasteSpecial Paste:=xlValues
        Case 7:
            .Range("Y4").PasteSpecial Paste:=xlValues
        Case 8:
            .Range("Z4").PasteSpecial Paste:=xlValues
        Case 9:
            .Range("AA4").PasteSpecial Paste:=xlValues
        Case 10:
            .Range("AB4").PasteSpecial Paste:=xlValues
        Case 11:
            .Range("AC4").PasteSpecial Paste:=xlValues
        Case 12:
            .Range("AD4").PasteSpecial Paste:=xlValues
    End Select
End With
 
With Ziel
Quelle.Range("P8:P107").Copy
    Select Case Quelle.Range("E2").Value And ActiveSheet.Range("D3") = Tabelle17.Name
        Case 1:
            .Range("AI4").PasteSpecial Paste:=xlValues
        Case 2:
            .Range("AJ4").PasteSpecial Paste:=xlValues
        Case 3:
            .Range("AK4").PasteSpecial Paste:=xlValues
        Case 4:
            .Range("AL4").PasteSpecial Paste:=xlValues
        Case 5:
            .Range("AM4").PasteSpecial Paste:=xlValues
        Case 6:
            .Range("AN4").PasteSpecial Paste:=xlValues
        Case 7:
            .Range("AO4").PasteSpecial Paste:=xlValues
        Case 8:
            .Range("AP4").PasteSpecial Paste:=xlValues
        Case 9:
            .Range("AQ4").PasteSpecial Paste:=xlValues
        Case 10:
            .Range("AR4").PasteSpecial Paste:=xlValues
        Case 11:
            .Range("AS4").PasteSpecial Paste:=xlValues
        Case 12:
            .Range("AT4").PaseSpecial Paste:=xlValues
    End Select
End With
 
        Ziel.protect Password:="pass"
        Worksheets("PRÄ").Select
        Range("C2").Select
 
End Sub

 

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:
WYSIWYG-Editor, ctl00_Content_editor1



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot VBA Excel Code mit Variablen vereinfachen - 2 if Abfragen
 12.05.2018 15:48:12 Steven
NotSolved
12.05.2018 18:54:12 AlterDresdner
NotSolved
12.05.2018 19:03:55 Gast26575
NotSolved
12.05.2018 19:02:00 AlterDresdner
NotSolved
12.05.2018 19:07:15 Gast95208
NotSolved
12.05.2018 23:55:13 Gast48150
NotSolved
13.05.2018 15:00:32 Gast11923
NotSolved