Excel 2007 VBA Macro

cyberbard used Ask the Experts™
I am needing help with a vba macro in excel 2007. I need to come up with a macro in excel that will copy data in one cell on sheet 2 to a "range" of cells in sheet one. The cell to copy from sheet 2 will always be the same, but the data will change as someone enters it. I need this macro to check the cell in the range in sheet1 to make sure it is empty before copying data from sheet 2 to sheet 1. If the cell has data, it needs to move 1 cell down in the same column. Any help is appreciated. Thanks.
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
A single file with a few data is worth much more than a thousand words of explanation. Can you upload a small sample showing what you want?


Sure, hope the file helps explain a little better. This will go on a spreadsheet where people enter an amount in sheet 2 to print a receipt, but they want the amount entered to paste over to sheet 1 and make a list of the amounts.


Sub CopyDataToPlan()

    Dim LDate As String
    Dim LColumn As Integer
    Dim LFound As Boolean

    On Error GoTo Err_Execute

    'Retrieve date value to search for
    LDate = Sheets("Rolling Plan").Range("B4").Value


    'Start at column B
    LColumn = 2
    LFound = False

    While LFound = False

        'Encountered blank cell in row 2, terminate search
        If Len(Cells(2, LColumn)) = 0 Then
            MsgBox "No matching date was found."
            Exit Sub

        'Found match in row 2
        ElseIf Cells(2, LColumn) = LDate Then

            'Select values to copy from "Rolling Plan" sheet
            Sheets("Rolling Plan").Select

            'Paste onto "Plan" sheet
            Cells(3, LColumn).Select
            Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=False

            LFound = True
            MsgBox "The data has been successfully copied."

        'Continue searching
            LColumn = LColumn + 1
        End If


    On Error GoTo 0

    Exit Sub

    MsgBox "An error occurred."

End Sub

Open in new window

hope this helps
OWASP: Forgery and Phishing

Learn the techniques to avoid forgery and phishing attacks and the types of attacks an application or network may face.

Right-click on the sheet tab name for sheet2
select view code
enter this code in the vba window
close the vba window

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = Range("C6").Address Then
Sheet1.Range("B" & Rows.Count).End(xlUp).Offset(1).Value = Target.Value
End If
End Sub


Alright thank you both, I'll see which one/both works good for me.


Thank you for a concise solution!

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial