VBA Code Kürzen

Private Sub CommandButton1_Click()
With Worksheets("Mannschaft")
'Plan 407 02
.Cells(2, 3) = TextBox001.Value
.Cells(2, 4) = TextBox002.Value
.Cells(3, 3) = TextBox003.Value
.Cells(3, 4) = TextBox004.Value
.Cells(4, 3) = TextBox005.Value
.Cells(4, 4) = TextBox006.Value
.Cells(5, 3) = TextBox007.Value
.Cells(5, 4) = TextBox008.Value
.Cells(6, 3) = TextBox009.Value
.Cells(6, 4) = TextBox010.Value
.Cells(7, 3) = TextBox011.Value
.Cells(7, 4) = TextBox012.Value
.Cells(8, 3) = TextBox013.Value
.Cells(8, 4) = TextBox014.Value
.Cells(9, 3) = TextBox015.Value
.Cells(9, 4) = TextBox016.Value
'Plan 407 06
.Cells(10, 3) = TextBox018.Value
.Cells(10, 4) = TextBox019.Value
.Cells(11, 3) = TextBox020.Value
.Cells(11, 4) = TextBox021.Value
.Cells(12, 3) = TextBox022.Value
.Cells(12, 4) = TextBox023.Value
.Cells(13, 3) = TextBox024.Value
.Cells(13, 4) = TextBox025.Value
.Cells(14, 3) = TextBox026.Value
.Cells(14, 4) = TextBox027.Value
.Cells(15, 3) = TextBox028.Value
.Cells(15, 4) = TextBox029.Value
.Cells(16, 3) = TextBox030.Value
.Cells(16, 4) = TextBox031.Value
.Cells(17, 3) = TextBox032.Value
.Cells(17, 4) = TextBox033.Value
'Plan 407 10
.Cells(18, 3) = TextBox035.Value
.Cells(18, 4) = TextBox036.Value
.Cells(19, 3) = TextBox037.Value
.Cells(19, 4) = TextBox038.Value
.Cells(20, 3) = TextBox039.Value
.Cells(20, 4) = TextBox040.Value
.Cells(21, 3) = TextBox041.Value
.Cells(21, 4) = TextBox042.Value
.Cells(22, 3) = TextBox043.Value
.Cells(22, 4) = TextBox044.Value
.Cells(23, 3) = TextBox045.Value
.Cells(23, 4) = TextBox046.Value
.Cells(24, 3) = TextBox047.Value
.Cells(24, 4) = TextBox048.Value
.Cells(25, 3) = TextBox049.Value
.Cells(25, 4) = TextBox050.Value
'Plan 407 14
.Cells(26, 3) = TextBox052.Value
.Cells(26, 4) = TextBox053.Value
.Cells(27, 3) = TextBox054.Value
.Cells(27, 4) = TextBox055.Value
.Cells(28, 3) = TextBox056.Value
.Cells(28, 4) = TextBox057.Value
.Cells(29, 3) = TextBox058.Value
.Cells(29, 4) = TextBox059.Value
.Cells(30, 3) = TextBox060.Value
.Cells(30, 4) = TextBox061.Value
.Cells(31, 3) = TextBox062.Value
.Cells(31, 4) = TextBox063.Value
.Cells(32, 3) = TextBox064.Value
.Cells(32, 4) = TextBox065.Value
.Cells(33, 3) = TextBox066.Value
.Cells(33, 4) = TextBox067.Value
'Plan 407 18
.Cells(34, 3) = TextBox069.Value
.Cells(34, 4) = TextBox070.Value
.Cells(35, 3) = TextBox071.Value
.Cells(35, 4) = TextBox072.Value
.Cells(36, 3) = TextBox073.Value
.Cells(36, 4) = TextBox074.Value
.Cells(37, 3) = TextBox075.Value
.Cells(37, 4) = TextBox076.Value
.Cells(38, 3) = TextBox077.Value
.Cells(38, 4) = TextBox078.Value
.Cells(39, 3) = TextBox079.Value
.Cells(39, 4) = TextBox080.Value
.Cells(40, 3) = TextBox081.Value
.Cells(40, 4) = TextBox082.Value
.Cells(41, 3) = TextBox083.Value
.Cells(41, 4) = TextBox084.Value
'Plan 407 22
.Cells(42, 3) = TextBox086.Value
.Cells(42, 4) = TextBox087.Value
.Cells(43, 3) = TextBox088.Value
.Cells(43, 4) = TextBox089.Value
.Cells(44, 3) = TextBox090.Value
.Cells(44, 4) = TextBox091.Value
.Cells(45, 3) = TextBox092.Value
.Cells(45, 4) = TextBox093.Value
.Cells(46, 3) = TextBox094.Value
.Cells(46, 4) = TextBox095.Value
.Cells(47, 3) = TextBox096.Value
.Cells(47, 4) = TextBox097.Value
.Cells(48, 3) = TextBox098.Value
.Cells(48, 4) = TextBox099.Value
.Cells(49, 3) = TextBox100.Value
.Cells(49, 4) = TextBox101.Value
'Plan 407 26
.Cells(50, 3) = TextBox103.Value
.Cells(50, 4) = TextBox104.Value
.Cells(51, 3) = TextBox105.Value
.Cells(51, 4) = TextBox106.Value
.Cells(52, 3) = TextBox107.Value
.Cells(52, 4) = TextBox108.Value
.Cells(53, 3) = TextBox109.Value
.Cells(53, 4) = TextBox110.Value
.Cells(54, 3) = TextBox111.Value
.Cells(54, 4) = TextBox112.Value
.Cells(55, 3) = TextBox113.Value
.Cells(55, 4) = TextBox114.Value
.Cells(56, 3) = TextBox115.Value
.Cells(56, 4) = TextBox116.Value
.Cells(57, 3) = TextBox117.Value
.Cells(57, 4) = TextBox118.Value
End With
Me.Hide
Range("A3").Select
End Sub

Private Sub UserForm_Initialize()
With Worksheets("Mannschaft")
'Datum & KW
Label4 = .Cells(1, 9).Text
Label5 = .Cells(2, 9).Text
'Plan 407 02
TextBox001 = .Cells(2, 3).Text
TextBox002 = .Cells(2, 4).Text
TextBox003 = .Cells(3, 3).Text
TextBox004 = .Cells(3, 4).Text
TextBox005 = .Cells(4, 3).Text
TextBox006 = .Cells(4, 4).Text
TextBox007 = .Cells(5, 3).Text
TextBox008 = .Cells(5, 4).Text
TextBox009 = .Cells(6, 3).Text
TextBox010 = .Cells(6, 4).Text
TextBox011 = .Cells(7, 3).Text
TextBox012 = .Cells(7, 4).Text
TextBox013 = .Cells(8, 3).Text
TextBox014 = .Cells(8, 4).Text
TextBox015 = .Cells(9, 3).Text
TextBox016 = .Cells(9, 4).Text
'Std. Anzahl Jahr 407 02
TextBox017 = .Cells(2, 7).Text
'Plan 407 06
TextBox018 = .Cells(10, 3).Text
TextBox019 = .Cells(10, 4).Text
TextBox020 = .Cells(11, 3).Text
TextBox021 = .Cells(11, 4).Text
TextBox022 = .Cells(12, 3).Text
TextBox023 = .Cells(12, 4).Text
TextBox024 = .Cells(13, 3).Text
TextBox025 = .Cells(13, 4).Text
TextBox026 = .Cells(14, 3).Text
TextBox027 = .Cells(14, 4).Text
TextBox028 = .Cells(15, 3).Text
TextBox029 = .Cells(15, 4).Text
TextBox030 = .Cells(16, 3).Text
TextBox031 = .Cells(16, 4).Text
TextBox032 = .Cells(17, 3).Text
TextBox033 = .Cells(17, 4).Text
'Std. Anzahl Jahr 407 06
TextBox034 = .Cells(10, 7).Text
'Plan 407 10
TextBox035 = .Cells(18, 3).Text
TextBox036 = .Cells(18, 4).Text
TextBox037 = .Cells(19, 3).Text
TextBox038 = .Cells(19, 4).Text
TextBox039 = .Cells(20, 3).Text
TextBox040 = .Cells(20, 4).Text
TextBox041 = .Cells(21, 3).Text
TextBox042 = .Cells(21, 4).Text
TextBox043 = .Cells(22, 3).Text
TextBox044 = .Cells(22, 4).Text
TextBox045 = .Cells(23, 3).Text
TextBox046 = .Cells(23, 4).Text
TextBox047 = .Cells(24, 3).Text
TextBox048 = .Cells(24, 4).Text
TextBox049 = .Cells(25, 3).Text
TextBox050 = .Cells(25, 4).Text
'Std. Anzahl Jahr 407 10
TextBox051 = .Cells(18, 7).Text
'Plan 407 14
TextBox052 = .Cells(26, 3).Text
TextBox053 = .Cells(26, 4).Text
TextBox054 = .Cells(27, 3).Text
TextBox055 = .Cells(27, 4).Text
TextBox056 = .Cells(28, 3).Text
TextBox057 = .Cells(28, 4).Text
TextBox058 = .Cells(29, 3).Text
TextBox059 = .Cells(29, 4).Text
TextBox060 = .Cells(30, 3).Text
TextBox061 = .Cells(30, 4).Text
TextBox062 = .Cells(31, 3).Text
TextBox063 = .Cells(31, 4).Text
TextBox064 = .Cells(32, 3).Text
TextBox065 = .Cells(32, 4).Text
TextBox066 = .Cells(33, 3).Text
TextBox067 = .Cells(33, 4).Text
'Std. Anzahl Jahr 407 14
TextBox068 = .Cells(26, 7).Text
'Plan 407 18
TextBox069 = .Cells(34, 3).Text
TextBox070 = .Cells(34, 4).Text
TextBox071 = .Cells(35, 3).Text
TextBox072 = .Cells(35, 4).Text
TextBox073 = .Cells(36, 3).Text
TextBox074 = .Cells(36, 4).Text
TextBox075 = .Cells(37, 3).Text
TextBox076 = .Cells(37, 4).Text
TextBox077 = .Cells(38, 3).Text
TextBox078 = .Cells(38, 4).Text
TextBox079 = .Cells(39, 3).Text
TextBox080 = .Cells(39, 4).Text
TextBox081 = .Cells(40, 3).Text
TextBox082 = .Cells(40, 4).Text
TextBox083 = .Cells(41, 3).Text
TextBox084 = .Cells(41, 4).Text
'Std. Anzahl Jahr 407 18
TextBox085 = .Cells(34, 7).Text
'Plan 407 22
TextBox086 = .Cells(42, 3).Text
TextBox087 = .Cells(42, 4).Text
TextBox088 = .Cells(43, 3).Text
TextBox089 = .Cells(43, 4).Text
TextBox090 = .Cells(44, 3).Text
TextBox091 = .Cells(44, 4).Text
TextBox092 = .Cells(45, 3).Text
TextBox093 = .Cells(45, 4).Text
TextBox094 = .Cells(46, 3).Text
TextBox095 = .Cells(46, 4).Text
TextBox096 = .Cells(47, 3).Text
TextBox097 = .Cells(47, 4).Text
TextBox098 = .Cells(48, 3).Text
TextBox099 = .Cells(48, 4).Text
TextBox100 = .Cells(49, 3).Text
TextBox101 = .Cells(49, 4).Text
'Std. Anzahl Jahr 407 22
TextBox102 = .Cells(42, 7).Text
'Plan 407 26
TextBox103 = .Cells(50, 3).Text
TextBox104 = .Cells(50, 4).Text
TextBox105 = .Cells(51, 3).Text
TextBox106 = .Cells(51, 4).Text
TextBox107 = .Cells(52, 3).Text
TextBox108 = .Cells(52, 4).Text
TextBox109 = .Cells(53, 3).Text
TextBox110 = .Cells(53, 4).Text
TextBox111 = .Cells(54, 3).Text
TextBox112 = .Cells(54, 4).Text
TextBox113 = .Cells(55, 3).Text
TextBox114 = .Cells(55, 4).Text
TextBox115 = .Cells(56, 3).Text
TextBox116 = .Cells(56, 4).Text
TextBox117 = .Cells(57, 3).Text
TextBox118 = .Cells(57, 4).Text
'Std. Anzahl Jahr 407 26
TextBox119 = .Cells(50, 7).Text
Dim iPage As Integer
Dim sschicht As String
On Error GoTo Fehler
sschicht = ActiveSheet.Range("AF1")
For iPage = 0 To Me.MultiPage1.Pages.Count - 1
If Me.MultiPage1.Pages(iPage).Caption = sschicht Then
Me.MultiPage1.Value = iPage
Exit For
End If
Next
Fehler:
End With
End Sub