Linking worksheets

[jstew1223]

Can anyone help me with changing this code so that I can link multiple worksheets? I want to do exactly what this code does but with 9 different worksheets that will all be linked to the same one.

[VBA]Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Map As Variant, x As Variant
Dim i As Long, j As Long, k As Long, n As Long, nRows As Long
Dim cel As Range, rg As Range
Dim ws1 As Worksheet, ws2 As Worksheet

With Worksheets("Mapping") 'Map contains the mapping relationships
Set ws1 = Worksheets(.Range("A1").Value) 'Take name of first worksheet from Mapping!A1
Set ws2 = Worksheets(.Range("B1").Value) 'Take name of first worksheet from Mapping!B1
If Sh.Name <> ws1.Name And Sh.Name <> ws2.Name Then Exit Sub 'Neither linked worksheet was changed--exit sub
Map = Range(.Cells(2, 1), .Cells(65536, 2).End(xlUp))
End With
nRows = UBound(Map) 'Number of mapping relationships in table

Application.ScreenUpdating = False 'Turn off screenupdating so code runs faster and no flicker
Application.EnableEvents = False 'Turn off events so this sub isn't called recursively
On Error Goto errhandler 'If a fatal error occurs, turn screen updating and events handling back on

For i = 1 To nRows 'Remove workbook and worksheet name from the mapping table
For j = 1 To 2
x = InStr(1, Map(i, j), ":")
If x = 0 Then
Map(i, j) = Range(Map(i, j)).Address
Else
Map(i, j) = Range(Left(Map(i, j), x - 1)).Address & ":" & Range(Mid(Map(i, j), x + 1)).Address
End If
Next j
Next i

For Each cel In Target
Select Case Sh.Name
Case ws1.Name
For i = 1 To nRows
If Map(i, 1) <> "" Then
Set rg = ws1.Range(Map(i, 1))
If Not Intersect(rg, cel) Is Nothing Then 'Is cel contained in a mapped range?
j = cel.Row - rg.Row 'Number of rows cel is below start of mapped range
k = cel.Column - rg.Column 'Number of columns cel is to right of mapped range
'cel.Copy 'The PasteSpecial method preserves the relative relationship of formulas
'ws2.Range(Map(i, 2)).Cells(1, 1).Offset(j, k).PasteSpecial xlPasteFormulas
cel.Copy ws2.Range(Map(i, 2)).Cells(1, 1).Offset(j, k) 'Paste formats, values & formulas
Application.CutCopyMode = True 'Clear the clipboard
End If
End If
Next i
Case ws2.Name
For i = 1 To nRows
If Map(i, 2) <> "" Then
Set rg = ws2.Range(Map(i, 2))
If Not Intersect(rg, cel) Is Nothing Then
j = cel.Row - rg.Row
k = cel.Column - rg.Column
'cel.Copy
'ws1.Range(Map(i, 1)).Cells(1, 1).Offset(j, k).PasteSpecial xlPasteFormulas
cel.Copy ws1.Range(Map(i, 1)).Cells(1, 1).Offset(j, k)
Application.CutCopyMode = True
End If
End If
Next i
End Select
Next cel
errhandler:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub[/VBA]