Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1532to1536
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

Kopieren und einfügen in 2 Tabellenblättern

Kopieren und einfügen in 2 Tabellenblättern
11.01.2017 10:50:44
Patrick
Guten Tag
Ich bin leider kein VBA profi, aber ich versuche mich trotzdem manchmal.
Es geht um ein Excel mit 2 Blättern , ich versuche mehrere Ranges in andere zu kopieren und diese dann wieder leer zu machen. Mein Gebastel funktioniert auch solange ich im aktiven Blatt arbeite, also das Macro in jedem Blatt einzeln ausführe. Praktisch wäre natürlich wenn beides aufs mal erledigt würde.
Hier mein Code, sieht jemand wo es hakt?
Worksheets("Zubehör").Range("AO8:AO84").Select
Selection.Copy
Worksheets("Zubehör").Range("AK8:AK84").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Worksheets("Zubehör").Range("AH8:AH84").Select
Selection.Copy
Worksheets("Zubehör").Range("AD8:AD84").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Worksheets("Zubehör").Range("O8:O84").Select
Selection.Copy
Worksheets("Zubehör").Range("J8:J84").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Worksheets("Zubehör").Range("F8:F84").Select
Selection.Copy
Worksheets("Zubehör").Range("D8:D84").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Worksheets("Zubehör").Range("AF8:AF84,AH8:AH84").ClearContents
Worksheets("Zubehör").Range("AM8:AM84,AO8:AO84").ClearContents
Worksheets("Zubehör").Range("T8:Z84").ClearContents
Worksheets("Zubehör").Range("K8:N84").ClearContents
Worksheets("Zubehör").Range("F8:F84").ClearContents
"Hier beginnt die 2. Seite"
Worksheets("Cases").Range("AO11:AO268").Select
Selection.Copy
Worksheets("Cases").Range("AK11:AK268").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Worksheets("Cases").Range("AH11:AH268").Select
Selection.Copy
Worksheets("Cases").Range("AD11:AD268").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Worksheets("Cases").Range("O11:O268").Select
Selection.Copy
Worksheets("Cases").Range("J11:J268").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Worksheets("Cases").Range("F11:F268").Select
Selection.Copy
Worksheets("Cases").Range("D11:D268").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Worksheets("Cases").Range("AF11:AF268,AH11:AH268").ClearContents
Worksheets("Cases").Range("AM11:AM268,AO11:AO268").ClearContents
Worksheets("Cases").Range("T11:Z268").ClearContents
Worksheets("Cases").Range("K11:N268").ClearContents
Worksheets("Cases").Range("F11:F268").ClearContents
Vielen Dank schon mal.
Patrick

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Kopieren und einfügen in 2 Tabellenblättern
11.01.2017 11:06:00
ChrisL
Hi Patrick
Vielleicht so...
Sub t()
Call Vorgang(Worksheets("Zubehör"), 8, 84)
Call Vorgang(Worksheets("Cases"), 11, 268)
End Sub

Private Sub Vorgang(WS As Worksheet, lStart As Long, lEnde As Long)
With WS
.Range("AK" & lStart & ":AK" & lEnde) = .Range("AO" & lStart & ":AO" & lEnde).Value
.Range("AD" & lStart & ":AD" & lEnde) = .Range("AH" & lStart & ":AH" & lEnde).Value
.Range("J" & lStart & ":J" & lEnde) = .Range("O" & lStart & ":O" & lEnde).Value
.Range("D" & lStart & ":D" & lEnde) = .Range("F" & lStart & ":F" & lEnde).Value
.Range("AK" & lStart & ":AK" & lEnde) = .Range("AO" & lStart & ":AO" & lEnde).Value
.Range("AF" & lStart & ":AF" & lEnde).ClearContents
.Range("AH" & lStart & ":AH" & lEnde).ClearContents
.Range("AM" & lStart & ":AM" & lEnde).ClearContents
.Range("AO" & lStart & ":AO" & lEnde).ClearContents
.Range("T" & lStart & ":Z" & lEnde).ClearContents
.Range("K" & lStart & ":N" & lEnde).ClearContents
.Range("F" & lStart & ":F" & lEnde).ClearContents
End With
End Sub

cu
Chris
Anzeige

365 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige