Copy to the next available empty cell

[ged18]

Hi, I would like to copy a value in a cell using a macro from one worksheet to another in the same workbook. If B1 in worksheet 1 has a value of 200 then this to be copied into worksheet 2 in the range of A1:A20 BUT in the next available empty cell, so if A1:A10 are full then 200 must go in A11.

Thanks for any help.

[boylejob]

ged18,

I believe I can help you out, but I need a little more information.

1. The value you are wanting to copy, will it always be in cell B1 or will you be going down column B to check checking each cell for the value 200. Or should the code fire each time the value in B1 changes.

2. What do you want to happen when you reach cell A20 on the second sheet. Do you want the code to stop or should it continue on.

[ged18]

Thanks for your reply Jeff,

1. Yes, always in B1 but value will change.

2. The code to continue on.

regards Ged

[StephenR]

Worksheets(1).Range("B1").Copy Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1)

[boylejob]

Ged,

Here is the code. This will evaluate B1 everytime it is changed and if the value is equal to 200, it will move it to Sheet2

This goes in a standard module.

Sub MoveValue()

Dim wsSht1 As Worksheet, wsSht2 As Worksheet
Dim lRow As Long

Set wsSht1 = Sheets("Sheet1")
Set wsSht2 = Sheets("Sheet2")

If wsSht1.Cells(1, 2).Value = 200 Then
    
    'Finds last used cell in column A and adds 1 to it which
    'gives the next blank cell in column A
    lRow = wsSht2.Cells(Rows.Count, 1).End(xlUp).Row + 1
    
    'If all cells in colunm A are empty the last row formula gives
    'a row of 1.  This If statement accounts for that.
    If lRow = 2 And wsSht2.Cells(1, 1) = "" Then
        lRow = lRow - 1
    End If

    'Moves the data from B1 on Sheet1 to next available cell in column
    'A of Sheet2
    wsSht2.Cells(lRow, 1).Value = wsSht1.Cells(1, 2).Value
End If

End Sub

This goes in the Sheet1 object.

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Address = "$B$1" Then
        Call MoveValue
    End If
    
End Sub

[ged18]

Thanks Jeff,

I'll try it out tomorrow, thanks for your time it's very kind for you.

Ged.