Auto udfyldelse i række 1 indtil

Option Explicit
Dim SourceRange As Range, FillRange As Range, Cell As Range
Dim Count As Integer

Private Sub Worksheet_Change(ByVal Target As Range)
        If Not Intersect(Target, Range("E1")) Is Nothing Then
            Set SourceRange = Target
            Set Cell = SourceRange
            Count = -1
            Do
                Count = Count + 1
                Set Cell = Cell.Offset(0, 1)
            Loop Until Cell.Value <> ""
            If Count < 1 Then Exit Sub
            Set FillRange = Range(SourceRange, SourceRange.Offset(0, Count))
            SourceRange.AutoFill Destination:=FillRange
        End If
End Sub

Option Explicit
Dim wb As Workbook, ws As Worksheet
Dim SourceRange As Range, FillRange As Range, Cell As Range
Dim Count As Integer

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Set wb = ThisWorkbook
    If Not Sh.Name = wb.Sheets(1).Name Then ' kan udvides med flere ark ved at skrive inden "Then"
                                            ' or sh.name=wb.Sheets(2).name osv
        If Not Intersect(Target, Range("E1")) Is Nothing Then
            Set SourceRange = Target
            Set Cell = SourceRange
            Count = -1
            Do
                Count = Count + 1
                Set Cell = Cell.Offset(0, 1)
            Loop Until Cell.Value <> ""
            If Count < 1 Then Exit Sub
            Set FillRange = Range(SourceRange, SourceRange.Offset(0, Count))
            SourceRange.AutoFill Destination:=FillRange
        End If
    End If
End Sub

Sub test_Område()
MsgBox "Autofylder fra: $E$1 til: " & Range("E1").End(xlToRight).Offset(0, -1).Address
End Sub