Ok... I had a bit of time  so I looked at the code again.

The following will I think do what you want.

I've made 2 changes.
1) Instead of pasting the formula in I've *copied* it from row  3. That means
the formula keeps the relative references and "flows". Hehehe.
2) I've left the copy  and paste special till the end and done it for the
whole data area instead of one cell at a time.

If anything it should go a little faster now!



Sub subValueOut()

Dim rlCurrentRow3Cell As Range
Dim rlCurrentColumnCell As Range
Dim rlCurrentXCell As Range
Dim rlAllData As Range
Dim llColumn As Long
Dim llRow As Long
Dim slFormula As String
Dim llColumnWithXes As Long
Dim llDataStartRow As Long
Dim llDataEndRow As Long
Dim llDataStartColumn As Long
Dim llDataEndColumn As Long

' Set initial values.
slFormula = ""
llColumnWithXes = 6
llDataStartRow = 4
llDataEndRow = 15
llDataEndColumn = 5
llDataStartColumn = 1

' Go DOWN the X column.
For llRow = llDataStartRow To llDataEndRow

Set rlCurrentXCell = Cells(llRow, llColumnWithXes)
If UCase(rlCurrentXCell.Value) = "X" Then

' Got an X.
' Go ACROSS.
For llColumn = llDataStartColumn To llDataEndColumn

Set rlCurrentColumnCell = Cells(llRow, llColumn)
Set rlCurrentRow3Cell = Cells(3, llColumn)

' Copy cell in row 3 so that it "flows".
rlCurrentRow3Cell.Copy
rlCurrentColumnCell.Activate
ActiveSheet.Paste

DoEvents

Next llColumn

Else

' Skip this row if no X.

End If
Next llRow

' Done with formulae.

' Copy paste the whole data area.
Set rlAllData = Range( _
Cells(llDataStartRow, llDataStartColumn), _
Cells(llDataEndRow, llDataEndColumn) _
)
rlAllData.Copy
rlAllData.PasteSpecial _
Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False


MsgBox "Done."
End Sub