Find next empty cell and copy down-CodePudding

Hi I have the following code , what I need is line 6,7 and 8 to work together, by which I mean:
When a cell in H is changed it finds the next empty column which works fine but if more than one cell is copied and pasted it only enters the data in one cell!
If I use line 6 and not line 7 it puts data in all the cells but will not find next empty cell.

How can I combine the two?

1.  Private Sub worksheet_change(ByVal Target As Range)
2.  On Error GoTo errHandler:
3.  If Not Intersect(Range("A:A,H:H"), Target) Is Nothing Then
4.    If WorksheetFunction.CountA(Target) Then
5.      Application.EnableEvents = False
6.      'Target.Offset(, 4) = Environ("username") & "-" & Date
7.      Cells(Target.Row, Cells(Target.Row, 
              Columns.Count).End(xlToLeft).Column   1).Value = _
8.      Environ("username") & "-" & Date
9.    End If
10. End If
11. errHandler:
12.   Application.EnableEvents = True
13.   If Err.Number Then Err.Raise Err.Number
14. End Sub

CodePudding user response：

I think you want the following:

Private Sub worksheet_change(ByVal Target As Range)
    Application.EnableEvents = False
    On Error GoTo errHandler:
    Dim targetcell As Range
    For Each targetcell In Target.Cells
        If Not Intersect(Range("A:A,H:H"), targetcell) Is Nothing Then
            If WorksheetFunction.CountA(targetcell) Then
                Cells(targetcell.Row, Cells(targetcell.Row, Columns.count).End(xlToLeft).Column   1).Value = _
                Environ("username") & "-" & Date
            End If
        End If
    Next
errHandler:
    Application.EnableEvents = True
    If Err.Number Then Err.Raise Err.Number
End Sub