Schleife programmieren

Moin ich habe eine If then Anwesiung geschrieben bei der eine Zelle aufgrund eines Wertes in eíner anderen Zelle in einen bestimmten Ort kopiert wird. Bei meiner VBA Programmierung klappt das zwar aber bei mehr als einer Zeile wird die Geschwindigkeit so stark verringert das ein arbeiten nicht mehr möglich ist.
Hier der Code:


Private Sub Worksheet_Change(ByVal Target As Range)
Dim xWks As Worksheet
Set xWks = ThisWorkbook.Worksheets(1)
If xWks.Cells(1, 5) = 1 Then
xWks.Cells(4, 18).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 2 Then
xWks.Cells(4, 21).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 3 Then
xWks.Cells(4, 24).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 4 Then
xWks.Cells(4, 27).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 5 Then
xWks.Cells(4, 30).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 6 Then
xWks.Cells(4, 33).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 7 Then
xWks.Cells(4, 36).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 8 Then
xWks.Cells(4, 39).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 9 Then
xWks.Cells(4, 42).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 10 Then
xWks.Cells(4, 45).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 11 Then
xWks.Cells(4, 48).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 12 Then
xWks.Cells(4, 51).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 13 Then
xWks.Cells(4, 54).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 14 Then
xWks.Cells(4, 57).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 15 Then
xWks.Cells(4, 60).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 16 Then
xWks.Cells(4, 63).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 17 Then
xWks.Cells(4, 66).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 18 Then
xWks.Cells(4, 69).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 19 Then
xWks.Cells(4, 72).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 20 Then
xWks.Cells(4, 75).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 21 Then
xWks.Cells(4, 78).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 22 Then
xWks.Cells(4, 81).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 23 Then
xWks.Cells(4, 84).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 24 Then
xWks.Cells(4, 87).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 25 Then
xWks.Cells(4, 90).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 26 Then
xWks.Cells(4, 93).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 27 Then
xWks.Cells(4, 96).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 28 Then
xWks.Cells(4, 99).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 29 Then
xWks.Cells(4, 102).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 30 Then
xWks.Cells(4, 105).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 31 Then
xWks.Cells(4, 108).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 32 Then
xWks.Cells(4, 111).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 33 Then
xWks.Cells(4, 114).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 34 Then
xWks.Cells(4, 117).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 35 Then
xWks.Cells(4, 120).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 36 Then
xWks.Cells(4, 123).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 37 Then
xWks.Cells(4, 126).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 38 Then
xWks.Cells(4, 129).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 39 Then
xWks.Cells(4, 132).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 40 Then
xWks.Cells(4, 135).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 41 Then
xWks.Cells(4, 138).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 42 Then
xWks.Cells(4, 141).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 43 Then
xWks.Cells(4, 144).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 44 Then
xWks.Cells(4, 147).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 45 Then
xWks.Cells(4, 150).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 46 Then
xWks.Cells(4, 153).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 47 Then
xWks.Cells(4, 156).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 48 Then
xWks.Cells(4, 159).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 49 Then
xWks.Cells(4, 162).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 50 Then
xWks.Cells(4, 165).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 51 Then
xWks.Cells(4, 168).Value = xWks.Cells(4, 14).Value
End If
If xWks.Cells(1, 5) = 52 Then
xWks.Cells(4, 171).Value = xWks.Cells(4, 14).Value
End If
End Sub

Vielen Dank im voraus.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Beliebteste Forumthreads (12 Monate)

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread