Copy and Paste Optimierung

GermansolvedQuestion VB for Applications Entwicklung

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

Please also mark the comments that contributed to the solution of the article

Content-ID: 4810789516

Url: https://administrator.de/forum/copy-and-paste-optimierung-4810789516.html

Printed on: May 11, 2025 at 17:05 o'clock

2 Comments

Latest comment

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

Steffen

EDIT: Reihenfolge in rngs1 und rngs2 korrigiert.

Sehr nice, geht! Danke dir!

GermansolvedQuestion VB for Applications Entwicklung