Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1620to1624
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA Code Werte Copy nach Abfragen

VBA Code Werte Copy nach Abfragen
12.05.2018 15:59:25
Steven
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.
Vielen Dank schon mal für Eure Ideen...
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

21
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA Code Werte Copy nach Abfragen
12.05.2018 16:47:02
Luschi
Hallo Steven,
hier mal mein Versuch:

ub aktivesBlattToPdf()
Dim Quelle As Worksheet, Ziel As Worksheet
Dim iOffset As Integer
Set Quelle = ThisWorkbook.Worksheets("PRÄ")
Set Ziel = ThisWorkbook.Worksheets("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"
Select Case Quelle.Range("D3").Value
Case Tabelle15.Name: iOffset = 3  '(Spalte 'C')
Case Tabelle16.Name: iOffset = 19 '(Spalte 'S')
Case Tabelle17.Name: iOffset = 35 '(Spalte 'AI')
End If
Quelle.Range("P8:P107").Copy
iOffset = Quelle.Range("E2").Value
Ziel.Cells(4, iOffset - 1).PasteSpecial Paste:=xlValues
Ziel.Protect Password:="pass"
Application.Goto Worksheets("PRÄ").Range("C2"), False
Set Quelle = Nothing: Set Ziel = Nothing
End Sub
Gruß von Luschi
aus klein-Paris
Anzeige
AW: VBA Code Werte Copy nach Abfragen
12.05.2018 16:57:30
Gerd
Hallo Steven,
sind die Werte Quelle.Range("E2") und Range("E2") beim PdF-Dateinamen verschiedene Zellen?
Ist gewährleistet, dass einer der drei Tabellennamen in Quelle.Range("D3") und
in Quelle.Range("E2") 1 bis 12 stehen?
Gruß Gerd
AW: VBA Code Werte Copy nach Abfragen
12.05.2018 17:24:00
Steven
Hallo Gerd,
- Quelle.Range("E2") und Range("E2") ist die gleiche Zelle
- Ja diese Zellen sind immer mit gefüllt Quelle.Range("E2") vin 1,2,3,... bis 12 für Monate
Quelle.Range("D3") wird automatisch ausgefüllt und zeigt immer einen Tabellen Name
Gruß aus Thüringen
Steven
AW: VBA Code Werte Copy nach Abfragen
12.05.2018 17:11:15
Steven
Lieber Luschi,
erst mal besten Dank für die schnelle Reaktion, der Code sieht recht gut und kurz aus.
Läuft leider noch nicht, kommt die Meldung Fehler beim Kompilieren: End if ohne If-Block.
Habe dann etwas rum gespielt mit End Select an verschiedenen Stellen, unten vor End Sub kommt keine Fehlermeldung mehr, aber es wird nicht kopiert, weiter oben kommen die Fehlermeldung 400
Noch eine Idee?
Anzeige
AW: VBA Code Werte Copy nach Abfragen
12.05.2018 17:36:00
Luschi
Hallo Steven,
es muß natürlich End Select statt End If heißen:

Select Case Quelle.Range("D3").Value
Case Tabelle15.Name: iOffset = 3  '(Spalte 'C')
Case Tabelle16.Name: iOffset = 19 '(Spalte 'S')
Case Tabelle17.Name: iOffset = 35 '(Spalte 'AI')
End Select
Gruß von Luschi
aus klein-Paris
AW: VBA Code Werte Copy nach Abfragen
12.05.2018 17:39:48
Steven
Hallo Luschi in Klein-Paris,
das gatte ich schon probiert an der Stelle mit End Select, dann erstellt der Code die pdf (sowieso) aber kopiert nix und bringt die Meldung:
Laufzeitfehler '1004' Anwenungs- oder objektdefinierter Fehler
Haste noch ne Idee?
Steven
Anzeige
AW: VBA Code Werte Copy nach Abfragen
12.05.2018 17:43:50
Steven
Sorry, erstellt auch keine pdf, jetzt kommt Fehler; 400
hier auch noch....
12.05.2018 18:14:43
Werner
Hallo Steven,
...das hier mitzuteilen hälst du wohl nicht für nötig?
...http://www.vba-forum.de/forum/View.aspx?ziel=44731-VBA_Excel_Code_mit_Variablen_vereinfachen_-_2_if_Abfragen
Gruß Werner
AW: hier auch noch....
12.05.2018 18:21:16
Steven
Hallo Werner,
Habe das in dem anderen Forum auch rein gestellt, aber da habe ich noch keine Antwort erhalten.
Sorry ist das schlimm, dass ich das nicht erwähnt habe?
Gruß
Steven
AW: VBA Code Werte Copy nach Abfragen
12.05.2018 18:25:12
Steven
Der Code von Luschi, nochmals vielen Dank, sieht jedenfalls gut aus und deckt wohl auch die Aufgaben ab, leider hackt es sicher nur noch an einer Kleinigkeit, End Select ist ja plausibel, trotzdem kommt dann Fehler 400
Anzeige
AW: VBA Code Werte Copy nach Abfragen
12.05.2018 18:25:12
Steven
Der Code von Luschi, nochmals vielen Dank, sieht jedenfalls gut aus und deckt wohl auch die Aufgaben ab, leider hackt es sicher nur noch an einer Kleinigkeit, End Select ist ja plausibel, trotzdem kommt dann Fehler 400
AW: VBA Code Werte Copy nach Abfragen
12.05.2018 19:48:28
Luschi
Hallo Steven,
mit so einem Code in VB.Net odere C# ohne Beispiel würdest Du eine schallende Ohrfeige erhalten,
denn Programmcode ohne Beispieldatei ist schon kompliziert.
Ich hoffe, Du bist in der Lage, eine Beispieldatei mit Dummy-Daten zu erstellen und hier bereitzustellen.
Ansonsten lasse ich das Problem für mich ruhen.
Gruß von Luschi
aus klein-Paris
Anzeige
AW: VBA Code Werte Copy nach Abfragen
12.05.2018 20:56:10
Steven
Hallo Luschi,
habe die Dummy.xlsm mit dem Code hochgeladen
Grüße
Steven
AW: VBA Code Werte Copy nach Abfragen
12.05.2018 21:02:15
Steven
Hallo Luschi,
Nachtrag:
Hochgeladene Datei wurde auf dem Server unter: 121570.xlsm gespeichert und konnte von mir wieder abgerufen werden.
Gruß Steven
AW: VBA Code Werte Copy nach Abfragen
13.05.2018 10:38:17
Luschi
Hallo Steven,
hier meine korrigioerte Fassung: https://www.herber.de/bbs/user/121576.xlsm
Gruß von Luschi
aus klein-Paris
PS: Beim nächsten Upload den gesamten Pfad veröffentlichen und nicht nur den Dateinamen!
AW: VBA Code Werte Copy nach Abfragen
13.05.2018 11:04:05
Steven
Hallo lieber Luschi am Sonntag Morgen,
bin auch gerade am probieren statt Code schreiben, wie Ihr Profis das könnt. Vielen Dank für die Datei, klappt aber noch nicht, denn wenn ich in PRÄ unter E2 den Monat ändere, kopiert er immer in die Spalte JAN auf STATISTIK. zwar in der ausgewählten Gruppe, aber immer im ersten Monat.
Vielleicht war auch mit dem Kommentar: 'die Zielzelle muß auf die Größe (Anzahl der Zellen) des Kopierbereiches erweitert werden! weitere Änderungen gemeint, kriege ich aber noch nicht hin.
Schönen Sonntag
Steven
Anzeige
AW: VBA Code Werte Copy nach Abfragen
13.05.2018 11:39:55
Steven
NACHTRAG:
If Ziel.ProtectContents Then 'nur wenn Blatt geschützt ist, dann Schutz aufheben
Wollte ich noch integrieren, weil meine Datei aber immer als *.xlsm gespeichert wird und das durch ein Makro automatisch geschieht, wird mir wohl der Fehler angezeigt, dass das Makro nicht mit meiner Excelverion kompatibel ist, Excel 2016
AW: VBA Code Werte Copy nach Abfragen
13.05.2018 19:06:57
Luschi
Hallo Steven,
Deine Begründung zum Problem 'If Ziel.ProtectContents Then' kann ich überhaupt nicht verstehen, denn das funktionierte schon in 'Excel 2000' so.
Das Problem Änderung in 'Zelle E2' habe ich korigiert: https://www.herber.de/bbs/user/121579.xlsm
Gruß von Luschi
aus klein-Paris
Anzeige
AW: VBA Code Werte Copy nach Abfragen
13.05.2018 20:10:35
Steven
Hallo Luschi,
hab es jetzt nochmal anders geprüft, die Meldung hatte einen anderen Grund, ist richtig, dass es nichts mit der Excel Version zu tun hat.
Danke nochmals hab es jetzt ins Laufen gebracht Dank Eurer Hilfe
Schöne neue Woche
Steven
AW: VBA Code Werte Copy nach Abfragen
12.05.2018 20:48:02
Gerd
Hallo Steven,
ich habe meine beiden Rückfragen mit nein u. ja beantwortet. :-)
Zur Vereinfachung der Fehlersuche ist der Code etwas entzerrt.
Option Explicit
Dim Quelle As Worksheet
Dim Ziel As Worksheet
Sub Main()
Call aktivesBlattToPdf
Call Kopieren
End Sub
Sub aktivesBlattToPdf()
Set Quelle = Sheets("PRÄ")
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "" & Quelle.Name & "." & Quelle.Range("D3").Value & _
"." & Format(Date, "YY.") & Quelle.Range("E2") & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End Sub
Sub Kopieren()
Dim X As Variant, Y As Variant, z As Long, Destination As Range
Set Quelle = Sheets("PRÄ")
Set Ziel = Sheets("STATISTIK")
X = Array(Tabelle15.Name, Tabelle16.Name, Tabelle17.Name)
Y = Array("C4", "S4", "AI4")
z = Application.Match(Quelle.Range("D3").Value, X, 0)
Ziel.Unprotect Password:="pass"
Set Destination = Ziel.Range(Y(z - 1)).Offset(0, Quelle.Range("E2") - 1)
Quelle.Range("P8:P107").Copy
Destination.PasteSpecial xlPasteValues
Ziel.Protect Password:="pass"
Application.Goto Quelle.Range("C2")
Set Destination = Nothing: Set Ziel = Nothing: Set Quelle = Nothing
End Sub

Gruß Gerd
Anzeige
AW: VBA Code Werte Copy nach Abfragen
12.05.2018 21:31:09
Steven
Hallo Gerd,
vielen Dank für die Hilfe, habe das angepasst und läuft alles auf Anhieb. Ich habe auch eine Dummy.xlsm Arbeitsmappe unter 121570.xlsm hochgeladen, um es besser nachvollziehen zu können. Danke nochmals und Entchuldigung, weil ich das gleichzeitig in einem anderen Forum angefragt hatte, kommt nicht wieder vor.
Schönes WE und super Support von Euch
Steven

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige