Reference formula help

[jmarkc]

Good day-
I have been struggling with what should be an easy thing to calculate. I've spent a lot of time scouring the forum and tried several different things to accomplish the following with no success. I'm hoping someone can help me!

In the attached sample workbook, I have 3 tabs. Ultimately, I want to copy portions of 2 of the tabs and paste them onto the 3rd. That's working with the basic coding I've already written. What isn't working is that part of what is being copied contains a formula that references a specific place on the original worksheet. When it copies to the new one, the reference changes due to the relative location of the formula.

Since the areas being copied on each tab can change, I don't know an easy way to apply the formula to the appropriate cell.

Any help is very much appreciated!
Thanks in advance!

Update TEST.xlsm

[p45cal]

try this, simple and dirty, it might just work:

Sub Macro1()

' Macro1 Macro
'
'   Application.ScreenUpdating = False

Sheets("Project Summary").Columns("a:q").Delete
Sheets("Project Summary").Rows("1:100").RowHeight = 27

'   Copy Alan's Projects
Sheets("Alan").Select
Range("a1:o1").Copy
Sheets("Project Summary").Select
Range("a1").Select
ActiveSheet.Paste
Rows("2:2").RowHeight = 9
Application.CutCopyMode = False

Sheets("Alan").Select
Range("A3", Cells(Range("A3").End(xlDown).Row, Range("x3").End(xlToLeft).Column)).Select
xx = Selection.Formula
Selection.Copy
Sheets("Project Summary").Select
Range("a3").Select
ActiveSheet.Paste
Selection.Resize(UBound(xx), UBound(xx, 2)).Formula = xx 'you might also get away with just: Selection.Formula = xx
Sheets("alan").Select
Range("q4:r7").Select
Selection.Copy
Sheets("Project Summary").Select
Range("q4").Select
ActiveSheet.Paste
Application.CutCopyMode = False

Dim i As Integer
i = 4
Sheets("alan").Select
Do While Cells(i, 3).Value <> ""

  If Sheets("alan").Cells(i, 3) = "On Schedule" Then
    Sheets("Project Summary").Cells(i, 2) = "On Schedule"
  ElseIf Sheets("alan").Cells(i, 3) = "Late" Then
    Sheets("Project Summary").Cells(i, 2) = "Late"
  ElseIf Sheets("alan").Cells(i, 3) = "Complete" Then
    Sheets("Project Summary").Cells(i, 2) = "Complete"
  ElseIf Sheets("alan").Cells(i, 3) = "At Risk" Then
    Sheets("Project Summary").Cells(i, 2) = "At Risk"
  End If
  i = i + 1
Loop

'   Copy Charter's Projects

Sheets("Charter").Select
Range("a1:o1").Copy
Sheets("Project Summary").Select
Range("a500").End(xlUp).Offset(2, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).RowHeight = 9
Application.CutCopyMode = False

Sheets("Charter").Select
Range("A3", Cells(Range("A3").End(xlDown).Row, Range("p3").End(xlToLeft).Column)).Select
xx = Selection.Formula
Selection.Copy
Sheets("Project Summary").Select
Range("a500").End(xlUp).Offset(2, 0).Select
ActiveSheet.Paste
Selection.Resize(UBound(xx), UBound(xx, 2)).Formula = xx 'you might also get away with just: Selection.Formula = xx
Application.CutCopyMode = False

Dim c As Integer
c = 4
Sheets("charter").Select
Do While Cells(c, 3).Value <> ""

  If Sheets("charter").Cells(c, 3) = "On Schedule" Then
    Sheets("Project Summary").Cells(c, 2) = "On Schedule"
  ElseIf Sheets("charter").Cells(c, 3) = "Late" Then
    Sheets("Project Summary").Cells(c, 2) = "Late"
  ElseIf Sheets("charter").Cells(c, 3) = "Complete" Then
    Sheets("Project Summary").Cells(c, 2) = "Complete"
  ElseIf Sheets("charter").Cells(c, 3) = "At Risk" Then
    Sheets("Project Summary").Cells(c, 2) = "At Risk"
  End If
  c = c + 1
Loop

End Sub

new lines in red:

Sheets("Alan").Select
Range("A3", Cells(Range("A3").End(xlDown).Row, Range("x3").End(xlToLeft).Column)).Select
xx = Selection.Formula
Selection.Copy
Sheets("Project Summary").Select
Range("a3").Select
ActiveSheet.Paste
Selection.Resize(UBound(xx), UBound(xx, 2)).Formula = xx
Sheets("alan").Select
Range("q4:r7").Select
Selection.Copy
Sheets("Project Summary").Select
Range("q4").Select
ActiveSheet.Paste
Application.CutCopyMode = False

<snip>

Sheets("Charter").Select
Range("A3", Cells(Range("A3").End(xlDown).Row, Range("p3").End(xlToLeft).Column)).Select
xx = Selection.Formula
Selection.Copy
Sheets("Project Summary").Select
Range("a500").End(xlUp).Offset(2, 0).Select
ActiveSheet.Paste
Selection.Resize(UBound(xx), UBound(xx, 2)).Formula = xx
Application.CutCopyMode = False

[jmarkc]

Thanks very much! This seems to work perfectly. I appreciate your help with this!!