elinize sağlık sayın Atoykan istediğim şekilde olmuş. bir sorum daha olacak siz ve site sakinlerine.

Sayın Atoykanın verdiği kodda düzenleme yaptım. ama bu kodu başka bir kodla birleştirmem gerekiyor ama yapamadım.

bu kodu:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cellsarr As Variant, i As Integer


cellsarr = Array("F3", "G3", "H3", "I3", "J3", "K3", "L3", "M3", "N3", "O3", "P3", "Q3", "R3", "S3", "T3", "U3", "V3", "W3", "X3", "Y3")

' İzlenen hücreleri belirle


For i = LBound(cellsarr) To UBound(cellsarr)
Dim CurrentCell As Range
Set CurrentCell = Me.Range(cellsarr(i))

' Hücreye değer girildiyse ve değeri boş değilse satır ekle ve değeri yaz, değer silindi ise satırı sil
If Not Intersect(Target, CurrentCell) Is Nothing Then
Application.EnableEvents = False

'Buradaki sayı verinin ekleneceği satır başlangıcı
If CurrentCell.Value <> "" Then
Me.Rows(i + 24 & ":" & i + 24).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Me.Cells(i + 8, 2).Value = CurrentCell.Value
Else
Me.Rows(i + 24).Delete Shift:=xlUp
End If

Application.EnableEvents = True
End If
Next i
End Sub

bu koda birleştirmek gerekiyor. üstteki kodun
cellsarr = Array("F3", "G3", "H3", "I3", "J3", "K3", "L3", "M3", "N3", "O3", "P3", "Q3", "R3", "S3", "T3", "U3", "V3", "W3", "X3", "Y3") satırındaki veriler ana sayfada hesaplama ile geliyor. o yüzden iki kodu entegre etmek gerekiyor.

Ana kod:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Set ws = ActiveSheet

' Eğer B4:B18 arasında bir değişiklik yapıldıysa
If Not Intersect(Target, ws.Range("B4:B18")) Is Nothing Then
Dim i As Long
For i = 5 To 18
' Eğer bir üst satırda veri varsa ve alt satır gizli ise aç
If ws.Cells(i - 1, 2).Value <> "" And ws.Rows(i).Hidden Then
ws.Rows(i).Hidden = False
ws.Cells(i, 2).Select ' Açılan satıra odaklan

Exit For
End If
Next i

' Eğer bir üst satırda veri yoksa ve alt satırda veri yoksa, satırı gizle
For j = 18 To 5 Step -1
If ws.Cells(j, 2).Value = "" And ws.Cells(j - 1, 2).Value = "" Then
ws.Rows(j).Hidden = True

End If
Next j
End If
' I3:Y3 satırlarını kontrol et
For Each col In ws.Range("I3:Y3").Columns
If Application.WorksheetFunction.CountA(col) = 0 Then
col.EntireColumn.Hidden = True
Else
col.EntireColumn.Hidden = False
col.EntireColumn.ColumnWidth = 6 ' Sütun genişliği 6 cm olarak ayarlanıyor

End If
Next col

' Diğer koşullar buraya eklenebilir
If Not Intersect(Target, ws.Range("G22")) Is Nothing Then
ws.Name = ws.Range("G22").Value
End If
If Not Intersect(Target, ws.Range("B4:B18")) Is Nothing Then
ws.Range("G3:Y3").Value = ""
Aktar
End If
End Sub

saygılar iyi çalışmalar.