Copy and Paste within Range with selection criteria

[singcbl]

I have been trying to look for a macro that allows me to copy and paste down a column but the catch is this macro must allows the selection of a range to paste and it must be able to skip over blank rows which is based on a reference range which is either to the right or left of the target column.
For Example if cell A2 is the cell I want to copy from, the range of cells I am reference to is D2 to D10, the macro will then paste the formula or data from cell A2 down until cell A10. If there is any blank cell in D2 to D10 it should be smart enough to skip over them.
The previous macro that I were suggested are very specific with the position where the active cell and the reference range and this limit it flexibility.
Thanks in advance of your suggestion and help.

 

[Trebor76]

Hi singcbl,

Here's one way that firstly copies the formula in cell A2 down to the last cell found in Column D and then clears any of these copied formulas (from Column A only) where the adjacent cell in Column D is blank.

HTH

Robert

Sub Macro1()

Dim lngLastRow As Long
Dim rngCell As Range

lngLastRow = Cells(Rows.Count, "D").End(xlUp).Row

Range("A2").Copy Range("A3:A" & lngLastRow)

For Each rngCell In Range("A2:A" & lngLastRow)
    
    If IsEmpty(rngCell.Offset(0, 3)) = True Then
        rngCell.ClearContents
    End If
    
Next rngCell

End Sub

 

[singcbl]

Thanks for the codes. I am not too sure if this codes have the flexibility to allow me to select the range I want to match which can either be on the right or left of the target range. I think the codes should allow for an input box to select the reference range.

 

[Trebor76]

Run the following while the the cursor is on the cell with first formula (A2 in your example):

Sub Macro2()

Dim rngSelection, rngCell As Range
Dim strColActive As String
Dim lngRowFirst, lngRowLast As Long

strColActive = Mid(ActiveCell.Address, 2, _
               (InStr(2, ActiveCell.Address, "$")) - 2)

    On Error Resume Next
        Application.DisplayAlerts = False
            Set rngSelection = Application.InputBox(Prompt:= _
                "Use your mouse to select the reference range.", _
                    Title:="SPECIFY RANGE", Type:=8)
    On Error GoTo 0
        Application.DisplayAlerts = True

        If IsEmpty(rngSelection) = True Then
            Exit Sub
        Else
            For Each rngCell In rngSelection
                If lngRowFirst = 0 Then
                    lngRowFirst = rngCell.Row
                End If
            lngRowLast = rngCell.Row
            Next rngCell
        End If
        
Range(strColActive & lngRowFirst).Copy _
    Range(strColActive & lngRowFirst + 1 & ":" & strColActive & lngRowLast)
    
    For Each rngCell In Range(strColActive & lngRowFirst & ":" & strColActive & lngRowLast)
        If rngCell.Value = 0 Then
            rngCell.ClearContents
        End If
    Next rngCell

End Sub

 

[singcbl]

Thanks! What a relief, finally I got the answer to my request.

 

[Trebor76]

Thanks for the feedback and I'm glad it worked

 

[singcbl]

Trebo76,

Just one little nickpick I discovered if can be overcome will be great but if not I can live with what is possible now. I notice that if any of cells being referred to in the formula is empty the macro will skip the target range. That is to say if reference range cell A3 is with data but target cell C3 is suppose to have a formula that is referring to D3+E3 if either is empty, the formula will be copied to C3. Any suggestio?

 

[Trebor76]

Hi singcbl,

The macro initially copies down the range selected via the input box then goes back and clears all cells that return a zero, which is what is returned if the cell a formula is referencing to is blank. Maybe you need to build something in your formula that will return a certain unique value if the cell being referenced is blank, then tweak my macro to clear all the cells that return this value.

HTH

Robert

 

[singcbl]

Thanks for the suggestion, I will see what I can do.