Kürzer und einfacher?

Forumthread: 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

AW: Kürzer und einfacher?

21.07.2014 15:50:01

Daniel
Werte kopieren - kürzerer VBA-Code

21.07.2014 16:08:31

NoNet
Vielen Dank....

22.07.2014 10:19:23

Markus
Getestet...

22.07.2014 12:59:30

Markus
AW: Getestet...

25.07.2014 09:51:54

UweD

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

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

Beliebteste Forumthreads (12 Monate)

Forumthread: Kürzer und einfacher?

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

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread