Copy and Paste Optimierung

Moin moin,

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

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

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 10:03 Uhr

2 Kommentare

Neuester Kommentar

Irgendwas in der Art sollte es tun

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