Spalten zum einfügen wurden geändert

Sub zeileFinden()
Application.ScreenUpdating = False
Dim iClick As Integer
iClick = MsgBox( _
prompt:="Sollen die Tagesprüfungen eintragen werden?  Bitte mit den Prüfplänen  _
vergleichen.", _
Buttons:=vbYesNo)
If iClick = vbYes Then
Dim wks1 As Worksheet
Dim wks2 As Worksheet
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim Z As Long
Dim Ze As Integer
Dim Sp As Integer
Dim ArtNr As String
Dim c As Range
Set wks1 = Worksheets("Prüfungen")
Set wks2 = Worksheets("Artikeln")
Sheets("Prüfungen").Unprotect Password:="hh"
Sheets("Artikeln").Unprotect Password:="hh"
wks1.Range("A4:A13,A17:A26,A30:A39,A43:A52,F4:F13,F17:F26,F30:F39").ClearContents
For k = 1 To 10 ' Anzahl der Linien-Felder
If k  4 Then
j = 24
Else
j = 4
End If
For i = 27 To 52 ' alle betroffenen Spalten im Blatt Artikel durchlaufen
If wks2.Cells(Z, i)  "" Then
wks1.Cells(j, Sp) = wks2.Cells(Z, i)
j = j + 1
End If
Next i
Next k
Sheets("Artikeln").Protect Password:="hh"
Sheets("Prüfungen").Protect Password:="hh"
End If
'Dim iClick As Integer
iClick = MsgBox( _
prompt:=" Sollen die Tagesprüfungen ausgedruckt werden?  Bitte mit den Prüfplänen  _
vergleichen.", _
Buttons:=vbYesNo)
If iClick = vbYes Then
Worksheets("Prüfungen").Visible = True
Sheets("Prüfungen").PrintOut
Worksheets("Prüfungen").Visible = xlVeryHidden
ElseIf iClick = vbNo Then
Exit Sub
End If
Application.ScreenUpdating = True
End Sub