peki t sütunundaki aralık sabit mi?

EVET T SUTUNUNDAKI  RAKAMLAR SABİT

satır aralığını kast etmiştim
T15:T45 gibi

(13/10/2022, 12:25)berduş yazdı: satır aralığını kast etmiştim
T15:T45 gibi

 EVET EVET SABİT

aşağıdaki kodu VG sayfasının kod sayfasına yapıştırarak dener misiniz?
Not : ilgili sayfada benzer kod ve fonksiyonlar varsa silin
tekrar belirteyim kod VG sayfasına yapıştırılacak
son eklediğiniz dosyada kodlar BuÇalışmaKitabı modülüne yapıştırılmıştı

Dim EskiDgr





Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, ThisWorkbook.Worksheets("VG").Range("M18:M19")) Is Nothing Then

YeniDgr = Target.Value2

AramaE = 0

AramaY = 0

     Set Hdf = ThisWorkbook.Worksheets("KUYU")

    With Hdf

    SonStR = .Cells(.Rows.Count, "T").End(xlUp).Row

    tDz = .Range("T1:T" & SonStR).Value2

        For x = 1 To UBound(tDz)

            If tDz(x, 1) = EskiDgr Then AramaE = x

            If tDz(x, 1) = YeniDgr Then AramaY = x

        Next

        If AramaE > 0 And AramaY > 0 Then _

                                xDgr = .Cells(AramaE, "T").Offset(, 1).Value: .Cells(AramaY, "T").Offset(, 1).Value = xDgr: .Cells(AramaE, "T").Offset(, 1).Value = ""

    

    End With

End If

End Sub



Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    EskiDgr = Target.Value2

End Sub

(13/10/2022, 13:02)berduş yazdı: aşağıdaki kodu VG sayfasının kod sayfasına yapıştırarak dener misiniz?
Not : ilgili sayfada benzer kod ve fonksiyonlar varsa silin
tekrar belirteyim kod  VG sayfasına yapıştırılacak
son eklediğiniz dosyada kodlar BuÇalışmaKitabı modülüne yapıştırılmıştı

Dim EskiDgr





Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, ThisWorkbook.Worksheets("VG").Range("M18:M19")) Is Nothing Then

YeniDgr = Target.Value2

AramaE = 0

AramaY = 0

     Set Hdf = ThisWorkbook.Worksheets("KUYU")

    With Hdf

    SonStR = .Cells(.Rows.Count, "T").End(xlUp).Row

    tDz = .Range("T1:T" & SonStR).Value2

        For x = 1 To UBound(tDz)

            If tDz(x, 1) = EskiDgr Then AramaE = x

            If tDz(x, 1) = YeniDgr Then AramaY = x

        Next

        If AramaE > 0 And AramaY > 0 Then _

                                xDgr = .Cells(AramaE, "T").Offset(, 1).Value: .Cells(AramaY, "T").Offset(, 1).Value = xDgr: .Cells(AramaE, "T").Offset(, 1).Value = ""

    

    End With

End If

End Sub



Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    EskiDgr = Target.Value2

End Sub

EKLEDIM OLDU ÇOK TESEKKUR EDERİM YARDIMINIZ ICIN SAĞOLUN