Link to original cell, it is possible?

[gaba]

Hi everybody,
I've been trying to make this work for a long time and I start thinking is
not possible... Any help would be greatly appreciated

this is part of the code, everything is working but the link to the original
c.cell. I've tried to link to the address, run a macro, pull my hair, nothing
works....

For Each c In Range(ActiveCell.Offset(0, 3).Address, lastC & i + 15)
If c.Interior.ColorIndex = 8 Then

DestChk1 = ActiveCell.Offset(0, -1).Value
Set SrcChk1 = MethRange.Find(What:=DestChk1,
LookAt:=xlWhole, _
SearchOrder:=xlByColumns)

If Not SrcChk1 Is Nothing Then
SrcFnd1 = SrcChk1.Offset(0, 5).Value 'reporting unit
SrcFnd2 = SrcChk1.Offset(0, 6).Value / 1000 ' detection
limit
SrcFnd3 = SrcChk1.Offset(0, 19).Value 'method used
SrcFnd4 = SrcChk1.Offset(0, 20).Value 'date
End If

SrcFnd5 = Cells(15, c.Column()).Value
SrcFnd6 = Cells(11, c.Column()).Value

Cells(DestRow, DestCol).Value = ActiveCell.Offset(0,
-1).Value

If Cells(DestRow - 1, DestCol + 1).Value = "" Then
Cells(DestRow - 1, DestCol + 1).Value = SrcFnd5 'SrcFnd5
End If

With Cells(DestRow, DestCol + 1)
ActiveSheet.Paste Link:=True
.Value = c.Value

'I need to link the destination cell with c.value

.NumberFormat = c.NumberFormat
.Interior.ColorIndex = 8
End With

Cells(DestRow, DestCol + 2).Value = SrcFnd1
Cells(DestRow, DestCol + 3).Value = SrcFnd6
Cells(DestRow, DestCol + 4).Value = SrcFnd2
Cells(DestRow, DestCol + 5).Value = SrcFnd3
Cells(DestRow, DestCol + 6).Value = SrcFnd4
Cells(DestRow, DestCol + 6).NumberFormat = "mm/dd/yyyy"
DestCol = DestCol + 8
End If

Next

Thanks

 

[gaba]

Well, I have the destination cells linking to the original cell with this
piece of code

With Cells(DestRow, DestCol + 1)
c.Copy
.PasteSpecial Paste:=xlPasteValues
.Value = c.Value
ActiveSheet.Paste Link:=True
Application.CutCopyMode = False
.NumberFormat = c.NumberFormat
.Interior.ColorIndex = 8
End With

Now it goes to the last column and stops the loop. I think is something to
do with the ActiveCell going somewhere else... Oh Boy, one fixed and the rest
destroyed...

Does anybody see Why?
Thanks
Gaba

 

[gaba]

Actually Dave Peterson post a formula that fix all

With Cells(DestRow, DestCol + 1)
.formula = "=" & c.address(external:=true)
end with

Just in case somebody else needs it
Gaba

 

[Dave Peterson]

Are you still using this version of your code?

Well, I have the destination cells linking to the original cell with this
piece of code

With Cells(DestRow, DestCol + 1)
c.Copy
.PasteSpecial Paste:=xlPasteValues
.Value = c.Value
ActiveSheet.Paste Link:=True
Application.CutCopyMode = False
.NumberFormat = c.NumberFormat
.Interior.ColorIndex = 8
End With

Now it goes to the last column and stops the loop. I think is something to
do with the ActiveCell going somewhere else... Oh Boy, one fixed and the rest
destroyed...

Does anybody see Why?
Thanks
Gaba

 

[gaba]

Hello again, Dave
No I'm not using it any more. After I read your answer I changed all this
mess to the simple line you gave me.

Thanks so much for your help.

Gaba