If I copy and paste data from one range to another the following code does
not work:
It should take each cell and move its contents to a database then update its
formule. Go on to next cell and so forth...


Private Sub Worksheet_Change(ByVal Target As Range)

Dim intCol As Integer
Dim intRow As Integer
Dim strQuote As String
Dim strCol As String
Dim C

On Error Resume Next

If Intersect(Target, Range("MgrSchedule")) Is Nothing Then
Exit Sub
End If

If Target.Value = "" Then Exit Sub

Application.ScreenUpdating = False

For Each C In Target

MoveData:

Select Case C.Column
Case 2
strCol = "B"
Case 4
strCol = "D"
Case 5
strCol = "E"
Case 7
strCol = "G"
Case 8
strCol = "H"
Case 10
strCol = "J"
Case 11
strCol = "K"
Case 13
strCol = "M"
Case 14
strCol = "N"
Case 16
strCol = "P"
Case 17
strCol = "Q"
Case 19
strCol = "S"
Case 20
strCol = "T"
Case 22
strCol = "V"
Case 23
strCol = "W"

End Select

strQuote = Chr(34)
intCol = Cells(5, C.Column).Value
intRow = Cells(C.Row, 25).Value

Worksheets("Manager Raw Data").Cells(intRow, intCol).Value = C.Value

Application.EnableEvents = False

C.Formula = "=IF(INDIRECT(" & strQuote & "'Manager Raw Data'!" & _
strQuote & "& ADDRESS($Y" & Target.Row & "," & strCol & "$5))=" & _
strQuote & strQuote & "," & strQuote & strQuote & ",INDIRECT(" & _
strQuote & "'Manager Raw Data'!" & strQuote & " & ADDRESS($Y" & _
Target.Row & "," & strCol & "$5)))"

Next

ThereIsAnError:

Done:

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub