Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1368to1372
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

Kürzer und einfacher?

Kürzer und einfacher?
21.07.2014 15:15:49
Markus
Hallo VBA Spezialisten!
Ich habe mir untenstehenden Code erarbeitet.
Möchte hier dann mal Nachfragen ob es, bzw. welche, Vereinfachungen es gibt.
Funktion: im Monitoring wird zuerst der Bereich geleert um dann nach und nach mit neuen Informationen aus der Datentabelle gefüllt zu werden.
Worksheets("03_Datentabelle").Select
Worksheets("03_Datentabelle").Range(Range("e2"), Range("F65536").End(xlUp)).Copy
Worksheets("04_Monitoring").Range("a5").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets("03_Datentabelle").Select
Worksheets("03_Datentabelle").Range(Range("j2"), Range("k65536").End(xlUp)).Copy
Worksheets("04_Monitoring").Range("c5").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets("03_Datentabelle").Select
Worksheets("03_Datentabelle").Range(Range("m2"), Range("n65536").End(xlUp)).Copy
Worksheets("04_Monitoring").Range("e5").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets("03_Datentabelle").Select
Worksheets("03_Datentabelle").Range(Range("s2"), Range("s65536").End(xlUp)).Copy
Worksheets("04_Monitoring").Range("g5").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets("04_Monitoring").Activate
End Sub

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Kürzer und einfacher?
21.07.2014 15:50:01
Daniel
HI
im Prinzip so
With Worksheets("03_Datentabelle")
.Range(.Range("e2"), .Range("F65536").End(xlUp)).Copy
Worksheets("04_Monitoring").Range("a5").PasteSpecial Paste:=xlPasteValues
.Range(.Range("j2"), .Range("k65536").End(xlUp)).Copy
Worksheets("04_Monitoring").Range("c5").PasteSpecial Paste:=xlPasteValues
usw.
end with

das bei WITH definierte Objekt wird in der Folge automatisch eingefügt, wenn ein Ausdruck mit einem Punkt beginnt.
Gruß Daniel

Werte kopieren - kürzerer VBA-Code
21.07.2014 16:08:31
NoNet
Hallo Markus,
eine einfache Verkürzung des Codes besteht darin, die redundanten Angaben der Tabellenblätter durch Objekt-Variablen zu ersetzen und natürlich die überflüssigen .Select - Anweisungen zu entfernen :
Sub Markus_Kopieren_kuerzer()
Dim wsQ As Worksheet, wsZ As Worksheet
Set wsQ = Worksheets("03_Datentabelle")
Set wsZ = Worksheets("04_Monitoring")
wsQ.Range([E2], Cells(Rows.Count, 6)).End(xlUp).Copy
wsZ.[A5].PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
wsQ.Range([J2], Cells(Rows.Count, 11)).End(xlUp).Copy
wsZ.[C5].PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
wsQ.Range([M2], Cells(Rows.Count, 14)).End(xlUp).Copy
wsZ.[E5].PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
wsQ.Range([S2], Cells(Rows.Count, 19)).End(xlUp).Copy
wsZ.[G5].PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
wsZ.Activate
End Sub
Wenn die Bereiche jetzt noch gleich groß wären (im letzten Vorgang wird nur 1 Spalte S kopiert - im Gegensatz zu den vorherigen Vorgängen mit je 2 Spalten), könnte man den Code noch etwas verkürzen :
Sub Markus_Kopieren_kuerzer2()
Dim wsQ As Worksheet, wsZ As Worksheet
Dim strSpaltenQ As String, strSpaltenZ As String, lngS As Long
Set wsQ = Worksheets("03_Datentabelle") 'QUELL-Blatt
Set wsZ = Worksheets("04_Monitoring")   'ZIEL-Blatt
strSpaltenQ = "EJMS"    'Quellspalten im QUELL-Blatt
strSpaltenZ = "ACEG"    'Zielspalten im ZIEL-Blatt
For lngS = 1 To Len(strSpaltenQ)
wsQ.Range(Range(Mid(strSpaltenQ, lngS, 1) & "2"), _
Range(Mid(strSpaltenQ, lngS, 1) & Rows.Count).Offset(, 1)).End(xlUp).Copy
wsZ.Range(Mid(strSpaltenZ, lngS, 1) & "5").PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Next
wsZ.Activate
End Sub
PS: Ich konnte beide Code-Varianten nicht testen, da ich keine Mappe mit diesen Tabellenblättern und Werten habe ;-)
Salut, NoNet

Anzeige
Vielen Dank....
22.07.2014 10:19:23
Markus
, ich werde die Codes gleich mal testen und Rückmeldung geben.
Gruß
Markus

Getestet...
22.07.2014 12:59:30
Markus
Hallo NoNet,
ich hab deinen Code getestet. Leider kommt am Anfang die Fehlermeldung : Laufzeitfehler 1004
Die Methode Range für das Objekt _Worksheet ist fehlgeschlagen.
Eine Testtabelle habe ich nun mit angefügt. https://www.herber.de/bbs/user/91627.xlsm
Woran kann es liegen?
Gruß
Markus

AW: Getestet...
25.07.2014 09:51:54
UweD
Kopieren:
- Du hast ( ) anstelle von " " genommen und
- eine schliessende Klammer falsch gesetzt.
- das entspechende Blatt mus noch angegeben werden
(Das kann aber durch das with und den spätere . geschehen...
Bei Markieren war es richtig
Sub Kopieren()
Dim wsQ As Worksheet, wsZ As Worksheet
Set wsQ = Worksheets("03_Datentabelle")
Set wsZ = Worksheets("04_Monitoring")
wsZ.Range("A5:g4000").ClearContents
With wsQ
.Range("E2", .Cells(Rows.Count, 6).End(xlUp)).Copy
wsZ.[A5].PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
.Range("J2", .Cells(Rows.Count, 11).End(xlUp)).Copy
wsZ.[C5].PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
.Range("M2", .Cells(Rows.Count, 14).End(xlUp)).Copy
wsZ.[E5].PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
.Range("S2", .Cells(Rows.Count, 19).End(xlUp)).Copy
wsZ.[G5].PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With
wsZ.Activate
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige