noname69
Nov 30, 2022
view1591
view2
0
Goto Top

Copy and Paste Optimierung

GermansolvedQuestionDevelopmentVB for Applications
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
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 4810789516

Url: https://administrator.de/contentid/4810789516

Printed on: April 27, 2024 at 16:04 o'clock

2 Comments
Latest comment
Goto Top
Member: rubberman
Solution rubberman Nov 30, 2022, updated at Dec 01, 2022 at 17:24:33 (UTC)
Goto Top
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.
Member: noname69
noname69 Jun 29, 2023 at 10:56:57 (UTC)
Goto Top
Sehr nice, geht! Danke dir!
GermansolvedQuestionDevelopmentVB for Applications