Código de Visual Basic no funciona adecuadamente

Pregunta para dante

Hola Dante La Macro que me ayudaste a Hacer esta presentando un problema.

Sub IngresarDatos()
'
' Ingresar_Datos Macro
'

    Application.ScreenUpdating = False
    Sheets("DataBase Bewerber").Select
    Range("A5").Select
    Selection.ListObject.ListRows.Add (1)
    Sheets("Bewerber einfügen").Select
    Range("C6:C20").Select
    Selection.Copy
    Sheets("DataBase Bewerber").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        ActiveWorkbook.Worksheets("DataBase Bewerber").ListObjects("DataBase"). _
        Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("DataBase Bewerber").ListObjects("DataBase"). _
        Sort.SortFields.Add Key:=Range("DataBase[[#All],[ID No.]]"), SortOn:= _
        xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("DataBase Bewerber").ListObjects("DataBase" _
        ).Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Sheets("Bewerber einfügen").Select
    Application.CutCopyMode = False
    Range("C6:C20").Select
    Selection.ClearContents
    Range("C3").Select
'For J = 2 To 5000
'If Sheet4.Cells(J, 2) = "" Then
 'H = J
'Exit For
'End If
'Next J
'Sheet4.Cells(H, 2) = Sheet2.Cells(3, 3)
'Sheet4.Cells(H, 3) = Sheet2.Cells(3, 6)
'Range("E3") = Range("E3").Value + 1
    Application.ScreenUpdating = True
End Sub

Sub SaveInformation()

For i = 5 To 100
If Sheet61.Cells(i, 2) = "" Then
 p = i
Exit For
End If
Next i
Application.ScreenUpdating = False
Sheet61.Cells(i, 1) = Sheet96.Cells(3, 3)
Sheet61.Cells(i, 2) = Sheet96.Cells(6, 3)
Sheet61.Cells(i, 3) = Sheet96.Cells(7, 3)
Sheet61.Cells(i, 4) = Sheet96.Cells(8, 3)
Sheet61.Cells(i, 5) = Sheet96.Cells(9, 3)
Sheet61.Cells(i, 6) = Sheet96.Cells(10, 3)
Sheet61.Cells(i, 7) = Sheet96.Cells(11, 3)
Sheet61.Cells(i, 8) = Sheet96.Cells(12, 3)
Sheet61.Cells(i, 9) = Sheet96.Cells(13, 3)
Sheet61.Cells(i, 10) = Sheet96.Cells(14, 3)
Sheet61.Cells(i, 11) = Sheet96.Cells(16, 3)
Sheet61.Cells(i, 12) = Sheet96.Cells(17, 3)
Sheet61.Cells(i, 13) = Sheet96.Cells(18, 3)

For j = 2 To 100
If Sheet62.Cells(j, 10) = "" Then
 H = j
Exit For
End If
Next j
Sheet62.Cells(j, 10) = Sheet96.Cells(6, 3)
Sheet62.Cells(j, 11) = Sheet96.Cells(3, 3)
Sheet62.Cells(j, 12) = Sheet96.Cells(3, 3)

MsgBox "gespeichert!"

Sheet96.Cells(3, 3) = Sheet96.Cells(3, 3) + 1
For i = 6 To 22
Sheet96.Cells(i, 3) = ""
Next i
Application.ScreenUpdating = True
End Sub

En la parte del código donde le digo los rangos que debe copiar y donde los debe copiar esta cometiendo un error y no encuentro la razón. El error que comete es que me esta copiando esto Sheet61.Cells(i, 11) = Sheet96. Cells(16, 3) en la columna 11 y en la doce y esto Sheet61.Cells(i, 12) = Sheet96. Cells(17, 3) lo esta copiando en la 13 y esto Sheet61.Cells(i, 13) = Sheet96. Cells(18, 3) lo esta copiando en la columna 14 aunque esta columna no esta incluida en el código

Podría alguien ayudarme a encontrar el error.