Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim LastRow As Long, RowCount As Integer, i As Integer, FirmValue As String
    
    Set ws = ThisWorkbook.Sheets(1) 'Hangi sayfa üzerinde işlem yapıyorsanız ona göre düzenleyin
    
    'Sadece D sütunundaki değişikliklere tepki ver
    If Not Intersect(Target, ws.Columns("D")) Is Nothing Then
        Application.EnableEvents = False
        
        For Each cell In Target    'D'de değişiklik varsa döngüye gir
            If cell.Value <> "" Then
                RowCount = cell.Value    'D sütunundaki sayı al
                FirmValue = ws.Cells(cell.Row, "A").Value    'A sütunundaki firma adını al
                LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row  'Son satırı belirle
                
                'Yeni satır ve değer ekleme işlemleri için alt döngüye gir
                For i = 1 To RowCount
                    With ws
                        .Cells(LastRow, "A").Value = FirmValue    'A sütununa firma adını yaz
                        .Cells(LastRow, "E").Value = Format(i, "00")    'E sütununa D'ye göre 01, 02 gibi değerleri yaz
                        .Cells(LastRow, "F").Value = FirmValue & "-KLP-" & .Cells(LastRow, "E").Value    'F sütununu doldur
                    End With
                    LastRow = LastRow + 1
                Next i
            End If
        Next cell
        Cells(LastRow, 1).Select   'İlk boş A hücresini seç
        Application.EnableEvents = True
    End If
End Sub