Untitled

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    Application.EnableEvents = False

    ' Değişiklik yapılan hücrenin A1 hücresi olup olmadığını kontrol edin
    If Target.Address = "$A$1" Then
        Dim valueToWrite As String
        valueToWrite = Target.Value
        
        Dim rowOffset As Integer
        rowOffset = 1
        
        ' A1 hücresinden aşağı doğru değeri yazın
        Do While valueToWrite <> ""
            ' A1 hücresindeki değeri, alttaki hücreye yazın
            Target.Offset(rowOffset, 0).Value = valueToWrite
            rowOffset = rowOffset + 1
            
            ' A1 hücresindeki değeri temizleyin ve bir sonraki değeri alın
            Target.Value = ""
            valueToWrite = Target.Offset(rowOffset, 0).Value
        Loop
    End If

    Application.EnableEvents = True
    On Error GoTo 0
End Sub