Sayın Hocalarım merhaba,
ekli örnekte d hücresine yazılan sayı kadar (d7 hücresinde görüleceği gibi) e hücresine 01, 02 , 03 gibi d hücresindeki sayı kadar satır eklemesi.
Saygılarımla,
Ahmet Yenginoğlu
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
kodu işinizi görecektir. Bu koda göre veri girişi yaptığınızda D sütununda sayısal bir değer girdiğinizde otomatik olarak istediğiniz alt satırları oluşturacaktır. Kodlarda neyin ne işlem yaptığını mümkün olduğu kadar commentlar ile belirttim siz ihtiyacınız doğrultusunda çalışmanıza uyarlayabilirsiniz, belirli değişiklikleri çok rahat yapabilecek seviyedesiniz zaten.