Ich habe eine Urlaubsliste, wo jeder Monat auf einem Sheet ist. Nun will ich per Makro eine Einzel-Jahres-Auflistung für nur eine Person machen und habe mir das per Macrorecorder aufzeichnen lassen. Leider ist die Formel ziemlich lang (weil ich auch die Formate mit übertragen haben möchte) und ich habe ni so viel ahnung wie ich diese kürzen soll.
Hat einer von euch eine gute Idee?
Noch was zum Inhalt: Es ist ein Userform, wo man Schicht und Namen auswählt und bei "OK" soll die untenstehende Formel greifen und das insgesamt für ca. 45 Personen, deswg. soll die Formel auch so kurz wie möglich werden.
Danke und Gruß Anja
Private Sub OKButton_Click()
If UserForm3.ComboBox2 = "Mustermann, Max" Then
Sheets(2).Select
Range("F13:AJ13").Select
Selection.Copy
Sheets(16).Select
Range("B6").Select
ActiveSheet.Paste
Rahmen
Sheets(3).Select
Range("F13:AG13").Select
Selection.Copy
Sheets(16).Select
Range("B10").Select
ActiveSheet.Paste
Rahmen
Sheets(4).Select
Range("F13:AJ13").Select
Selection.Copy
Sheets(16).Select
Range("B14").Select
ActiveSheet.Paste
Rahmen
Sheets(5).Select
Range("F13:AI13").Select
Selection.Copy
Sheets(16).Select
Range("B18").Select
ActiveSheet.Paste
Rahmen
Sheets(6).Select
Range("F13:AJ13").Select
Selection.Copy
Sheets(16).Select
Range("B22").Select
ActiveSheet.Paste
Rahmen
Sheets(7).Select
Range("F13:AI13").Select
Selection.Copy
Sheets(16).Select
Range("B26").Select
ActiveSheet.Paste
Rahmen
Sheets(8).Select
Range("F13:AJ13").Select
Selection.Copy
Sheets(16).Select
Range("B30").Select
ActiveSheet.Paste
Rahmen
Sheets(9).Select
Range("F13:AJ13").Select
Selection.Copy
Sheets(16).Select
Range("B34").Select
ActiveSheet.Paste
Rahmen
Sheets(10).Select
Range("F13:AI13").Select
Selection.Copy
Sheets(16).Select
Range("B38").Select
ActiveSheet.Paste
Rahmen
Sheets(11).Select
Range("F13:AJ13").Select
Selection.Copy
Sheets(16).Select
Range("B42").Select
ActiveSheet.Paste
Rahmen
Sheets(12).Select
Range("F13:AI13").Select
Selection.Copy
Sheets(16).Select
Range("B46").Select
ActiveSheet.Paste
Rahmen
Sheets(13).Select
Range("F13:AL13").Select
Selection.Copy
Sheets(16).Select
Range("B50").Select
ActiveSheet.Paste
Rahmen
Range("B1").Select
ActiveCell.FormulaR1C1 = "A-Schicht"
Range("B2").Select
ActiveCell.FormulaR1C1 = UserForm3.ComboBox2
Range("A1").Select
End If
Unload UserForm3
End Sub
Das Sub "Rahmen" ist wie folgt:
Sub Rahmen()
Application.CutCopyMode = False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End Sub