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