Copy and Paste Optimierung
Moin moin,
hab folgenden Code gebaut:
Es ist Copy und Paste von Tabellen aus einer Datei in eine andere mit einer festen Inputrange. Die einzige Tabelle die sich dabei in der Spaltenanzahl ändert ist die mit der XEP Range.
Bin noch ein "noob" und würde gerne wissen, ob und wie man den hier optimieren könnte.
Danke euch!
Gruß
Anonymous
hab folgenden Code gebaut:
Select Case Sheets("Input").Range("B3").Value
Case "Montag"
Sheets("Dienstag").Range("O24:XEP67").Clear
Sheets("Input").Range("A3:E16").Copy (Sheets("Dienstag").Range("A4"))
Sheets("Input").Range("A20:D21").Copy (Sheets("Dienstag").Range("A21"))
Sheets("Input").Range("A25:XEP68").Copy (Sheets("Dienstag").Range("O24"))
Worksheets("Dienstag").Activate
Worksheets("Dienstag").Range("A1").Select
Case "Dienstag"
Sheets("Mittwoch").Range("O24:XEP67").Clear
Sheets("Input").Range("A3:E16").Copy (Sheets("Mittwoch").Range("A4"))
Sheets("Input").Range("A20:D21").Copy (Sheets("Mittwoch").Range("A21"))
Sheets("Input").Range("A25:XEP68").Copy (Sheets("Mittwoch").Range("O24"))
Worksheets("Mittwoch").Activate
Worksheets("Mittwoch").Range("A1").Select
Case "Mittwoch"
Sheets("Donnerstag").Range("O24:XEP67").Clear
Sheets("Input").Range("A3:E16").Copy (Sheets("Donnerstag").Range("A4"))
Sheets("Input").Range("A20:D21").Copy (Sheets("Donnerstag").Range("A21"))
Sheets("Input").Range("A25:XEP68").Copy (Sheets("Donnerstag").Range("O24"))
Worksheets("Donnerstag").Activate
Worksheets("Donnerstag").Range("A1").Select
Case "Donnerstag"
Sheets("Freitag").Range("O24:XEP67").Clear
Sheets("Input").Range("A3:E16").Copy (Sheets("Freitag").Range("A4"))
Sheets("Input").Range("A20:D21").Copy (Sheets("Freitag").Range("A21"))
Sheets("Input").Range("A25:XEP68").Copy (Sheets("Freitag").Range("O24"))
Worksheets("Freitag").Activate
Worksheets("Freitag").Range("A1").Select
Case "Freitag"
Sheets("Montag").Range("O24:XEP157").Clear
Sheets("Input").Range("A3:K16").Copy (Sheets("Montag").Range("A4"))
Sheets("Input").Range("A20:D21").Copy (Sheets("Montag").Range("A21"))
Sheets("Input").Range("A25:XEP158").Copy (Sheets("Montag").Range("O24"))
Worksheets("Montag").Activate
Worksheets("Montag").Range("A1").Select
End Select
Bin noch ein "noob" und würde gerne wissen, ob und wie man den hier optimieren könnte.
Danke euch!
Gruß
Anonymous
Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben
Content-ID: 4810789516
Url: https://administrator.de/forum/copy-and-paste-optimierung-4810789516.html
Ausgedruckt am: 14.03.2025 um 13:03 Uhr
2 Kommentare
Neuester Kommentar
Irgendwas in der Art sollte es tun
Steffen
EDIT: Reihenfolge in rngs1 und rngs2 korrigiert.
Sub foobar()
Dim daysOfWeek As Variant, rngs1 As Variant, rngs2 As Variant, idx As Long, thisDay As String
daysOfWeek = Array("Montag", "Dienstag", "Mittwoch", "Donnerstag", "Freitag")
rngs1 = Array("O24:XEP157", "O24:XEP67", "O24:XEP67", "O24:XEP67", "O24:XEP67")
rngs2 = Array("O25:XEP158", "O25:XEP68", "O25:XEP68", "O25:XEP68", "O25:XEP68")
thisDay = Sheets("Input").Range("B3").Value
idx = Application.Match(thisDay, daysOfWeek, 0) Mod (UBound(daysOfWeek) + 1)
' MsgBox daysOfWeek(idx) & vbNewLine & rngs1(idx) & vbNewLine & rngs2(idx)
Sheets(daysOfWeek(idx)).Range(rngs1(idx)).Clear
Sheets("Input").Range("A3:E16").Copy (Sheets(daysOfWeek(idx)).Range("A4"))
Sheets("Input").Range("A20:D21").Copy (Sheets(daysOfWeek(idx)).Range("A21"))
Sheets("Input").Range(rngs2(idx)).Copy (Sheets(daysOfWeek(idx)).Range("O24"))
Worksheets(daysOfWeek(idx)).Activate
Worksheets(daysOfWeek(idx)).Range("A1").Select
End Sub
Steffen
EDIT: Reihenfolge in rngs1 und rngs2 korrigiert.