Excel Atadıgım Değerle Sutun İçesindeki Yazı Yukarıya Asagıya Tasınsın

1 2 3 4
13/10/2022, 11:52

berduş

peki t sütunundaki aralık sabit mi?
13/10/2022, 12:19

dd2708

EVET T SUTUNUNDAKI  RAKAMLAR SABİT
13/10/2022, 12:25

berduş

satır aralığını kast etmiştim
T15:T45 gibi
13/10/2022, 12:27

dd2708

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

berduş

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, 16:09

dd2708

(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
1 2 3 4