A sütunu değişen değere göre başlık satırını araya kopyala

[hectorfd]

Öncelikle merhabalar.
A sütununda işlem numarası değiştikçe 1. satırda yer alan başlık satırının kopyalanarak değişen işlem numarasının üzerine gelmesini istiyorum. İşlem numarası 2 olduğunda hemen üstüne 1. satır kopyalansın. İşlem numarası 3 olduğunda 1. satır (başlık satırı) hemen üstüne kopyalansın. Bu işlem son değere kadar tekrarlansın. Yardımlarınızı rica eder iyi çalışmalar dilerim

 

[Ziynettin]

Merhaba,

Dosyanız ekte.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Son As Integer, Sira_No As Integer, Say As Integer
Dim a(), X As Integer
On Error Resume Next


If Target.Column = 1 And Target.Row > 2 Then
    Son = Target.Row
    Sira_No = Target.Value
    a = Range("A3:A" & Son)
    
    For X = 1 To UBound(a)
        If a(X, 1) = Sira_No Then
            Say = Say + 1
        End If
    Next X
    
    If Say = 1 Then Target.Offset(, 1) = [B2]
End If
End Sub

 

[hectorfd]

Merhaba,

Dosyanız ekte.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Son As Integer, Sira_No As Integer, Say As Integer
Dim a(), X As Integer
On Error Resume Next


If Target.Column = 1 And Target.Row > 2 Then
    Son = Target.Row
    Sira_No = Target.Value
    a = Range("A3:A" & Son)
    
    For X = 1 To UBound(a)
        If a(X, 1) = Sira_No Then
            Say = Say + 1
        End If
    Next X
    
    If Say = 1 Then Target.Offset(, 1) = [B2]
End If
End Sub

Merhabalar.Vermiş olduğunuz kodu çalıştıramadım. Tekrar yardımınızı ricaederim

 

[hectorfd]

Merhabalar.Vermiş olduğunuz kodu çalıştıramadım. Tekrar yardımınızı ricaederim

Sub baslikEkle()
sat = 2
Do
sat = sat + 1
If Cells(sat, 1) <> "" And Cells(sat, 1) <> Cells(sat - 1, 1) Then
Rows(1).Copy
Rows(sat).Insert
sat = sat + 2
Else
End If
Loop Until Cells(sat, 1) = ""
Application.CutCopyMode = False
End Sub

Yukarıdaki kod ile sorunum çözümlenmiştir.Konu kapatılabilir.