This is how i approached a similar problem
Sub CopyDown(ByVal intCol As Integer, ByVal intStartRow As Integer)
'Macro for Copying Information down to blank cells
'From Data from Pivot Tables
'Written by DC on 15/01/2004
Dim dblLastRow As Double, dblRow1 As Double, dblrow2 As Double
Dim intMyRow As Integer
Dim strMyRange As String, StrMyText As String
dblLastRow = Range("A" & Rows.Count).End(xlUp).Row
dblrow2 = intStartRow
Do Until Cells(dblrow2, intCol).Row dblLastRow
dblRow1 = dblrow2
StrMyText = Cells(dblRow1, intCol).Formula
dblrow2 = Cells(dblRow1, intCol).End(xlDown).Offset(-1, 0).Row
If Cells(dblrow2, intCol).Formula = "" And dblrow2 <
dblLastRow Then
Range(Cells(dblRow1, intCol), Cells(dblrow2
intCol)).Formula = StrMyText
dblrow2 = dblrow2 + 1
ElseIf dblrow2 dblLastRow Then
dblrow2 = dblLastRow - 1
If Cells(dblrow2, intCol).Formula = "" Then
Range(Cells(dblRow1, intCol), Cells(dblrow2
intCol)).Formula = StrMyText
dblrow2 = dblrow2 - 1
End If
Exit Do
Else
dblrow2 = dblrow2 + 1
End If
Loop
End Sub
I passed two arguments in the inital instance one for the start row an
one for the start column
Hope this Helps
Davi
--
Message posted from
http://www.ExcelForum.com