Looping Copy and Paste properly

Question

Basically I have 3 columns each with its own irregular space of blank rows (They are actually row labels copied off the pivot table, 3 tiers).

I want to make each of the values populate down the blank rows below them and the next row label beneath to repeat the copy & paste routine, all the way until the end, for all 3 rows. I intend for the macro to run based starting from the active cell i have selected, so I should run the macro 3 times, once for each column.

I have tried my hands and ended up with the codes below but it is not giving me what I want, any help would be greatly appreciated.

Sub LoopCopyPaste()

Application.Goto Reference:="LoopCopyPaste"

Do Until Selection.Value = "(blank)"

    Selection.Copy
    Range(Selection, Selection.End(xlDown)).Select
    ActiveCell.Offset(-1, 0).Select
    ActiveSheet.Paste
    Selection.End(xlDown).Select
    Application.CutCopyMode = False

Loop

End Sub

[How to avoid using Select/Active statements](http://stackoverflow.com/questions/10714251/excel-macro-avoiding-using-select) and [How to determine last used row/column](http://stackoverflow.com/questions/11169445/error-finding-last-used-cell-in-vba/11169920#11169920) — Dmitry Pavliv, Jun 01 '14 at 13:02

score 0 · Answer 1 · answered Jun 04 '14 at 10:36

Here is a working solution. Quite an interesting problem even if I don't understand the need behind it!

Sub replaceBlanks()

' define variables
Dim column As Integer
Dim row As Integer
Dim lastRow As Integer
Dim previousValue As String
Dim value As String

' stop screen from updating to speed things up
Application.ScreenUpdating = False

' use the active sheet
With ActiveSheet

    ' get the current cell selected and the last row in column selected
    column = ActiveCell.column
    row = ActiveCell.row
    lastRow = .Cells(.Rows.Count, column).End(xlUp).row

    ' set previous value to the first cell
    previousValue = Cells(row, column).value

    ' iterate for every row between selected and last row with data in
    For i = row To lastRow
        ' set value = the content of that cell
        value = Cells(i, column).value
        ' if it contains nothing
        If Len(value) < 1 Then
            ' set the value of cell equal to the previous cell that had something in it
            Cells(i, column).value = previousValue
        ' if it contains something
        Else
            ' update the previous value and move on to next row
            previousValue = value
        End If

    Next i

End With

' update the screen at the end
Application.ScreenUpdating = True

End Sub

Looping Copy and Paste properly

1 Answers1