Koşula bağlı satır kaydırma

[Ali.]

Arkadaşlar merhabalar formda yeniyim içinden çıkamadığım bir tablo liste sorunum var excel kitabında 2 sayfam var 1. Sayfada a1 hücresinde 2 binkişilik değişken isim listem var 2. Sayfada a1 hücresini birinci sayfaya eşitledim ama 2. Sayfada b1,c1,d1 hücrelerine veri girişlerim oluyor isimlerin yeri değiştiğinde b1,c1,d1 hücresindeki verilerin isimin yazıldığı satıra taşınsın istiyorum bu mümkün mü şimdiden teşekkür ederim.

 

[md3m1ray]

merhaba anladığım kadarıyla yaptım dener misiniz?
sayfa 1 de listede yaptığınız değişikliğe göre sayfa 2 de isimlere göre veri taşınır

modüle ekleyip bu kodu yazın:

Dim geciciVeri As Object

Sub VerileriTasi()

    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim i As Long
    Dim j As Long
    Dim isim As String

    Set ws1 = ThisWorkbook.Sheets("Sayfa1")
    Set ws2 = ThisWorkbook.Sheets("Sayfa2")
  
    If geciciVeri Is Nothing Then
        MsgBox "Veriler saklanmadı! Önce 'Verileri Sakla' makrosunu çalıştırın.", vbExclamation
        Exit Sub
    End If
  
    ws2.Rows("1:" & ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row).ClearContents

    j = 1
    For i = 1 To ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
        isim = ws1.Cells(i, 1).Value
        ws2.Cells(j, 1).Value = isim
      
        If geciciVeri.exists(isim) Then
        
            ws2.Cells(j, 2).Value = geciciVeri(isim)(0)
            ws2.Cells(j, 3).Value = geciciVeri(isim)(1)
            ws2.Cells(j, 4).Value = geciciVeri(isim)(2)
        Else

            ws2.Cells(j, 2).Value = ""
            ws2.Cells(j, 3).Value = ""
            ws2.Cells(j, 4).Value = ""
        End If
      
        j = j + 1
    Next i

    MsgBox "Veriler başarıyla taşındı ve sıralandı!", vbInformation

End Sub

Sub VerileriSakla()

    Dim ws2 As Worksheet
    Dim i As Long
    Dim isim As String
  
    Set ws2 = ThisWorkbook.Sheets("Sayfa2")
    Set geciciVeri = CreateObject("Scripting.Dictionary")
  
    For i = 1 To ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row
        isim = ws2.Cells(i, 1).Value
        If isim <> "" Then
            geciciVeri(isim) = Array(ws2.Cells(i, 2).Value, ws2.Cells(i, 3).Value, ws2.Cells(i, 4).Value)
        End If
    Next i

    MsgBox "Veriler başarıyla saklandı!", vbInformation

End Sub

çalışma kitabına bunu yazın:

Private Sub Workbook_SheetActivate(ByVal Sh As Object)

    If Sh.Name = "Sayfa1" Then
        Call VerileriSakla
    ElseIf Sh.Name = "Sayfa2" Then
        Call VerileriTasi
    End If

End Sub

 

[Ali.]

emeğinize sağlık tam istediğim mantıkta çalışıyor çok teşekkür ederim.

 

[md3m1ray]

rica ederim iyi çalışmalar