Bilgileri Otomatik Getirme Hk.

[ultraslan38080]

Arkadaşlar bir okulda idareci olarak görev yapıyorum. E-okuldaki öğrenci bilgilerini toparlamak istiyorum.
E-okul raporlama kısmından aldığım öğrenci künye defterlerini sayfa1 e kaydettim. Burdaki bilgilerin ekteki gibi sayfa2 ye otomatik gelmesini istiyorum. Nasıl yapabiliriz? Yardımlarınızı talep ediyorum. Şimdiden çok teşekkürler.

http://dosya.co/rfqblt0a7gz8/ÖRNEK.xlsx.html

 

[PLİNT]

Merhaba
Asıl dosyanızdada sayfa düzeni aynı ise makro ile ek dosyadaki gibi olabilir
http://dosya.co/2mtp76dpgkus/ÖRNEK1.zip.html

 

[ultraslan38080]

Merhaba
Asıl dosyanızdada sayfa düzeni aynı ise makro ile ek dosyadaki gibi olabilir
http://dosya.co/2mtp76dpgkus/ÖRNEK1.zip.html

Kayma olmuş ama evet bu şekilde doğru. Nasıl yaptınız?

 

[PLİNT]

Kayma olmuş ama evet bu şekilde doğru. Nasıl yaptınız?

Merhaba
Sayfada 11. satırdaki gibi boşluklar varmış dikkat etmemişiz
Kodlar "Sayfa2" vba penceresindedir
Aşağıdaki gibi değişip deneyiniz

[SIZE="2"]Private Sub Worksheet_Change(ByVal Target As Range)
If Selection.Cells.Count <> 1 Then Exit Sub
If Target.Column <> 1 Or Target.Value = "" Then Exit Sub

Set s1 = Sheets("Sayfa1")
With s1.Cells
    Set c = .Find("Okul No", LookIn:=xlValues, lookat:=xlPart)

    If Not c Is Nothing Then
        f = c.Address
        Do
If s1.Cells(c.Row, c.Column + 4).Text = Target.Text Then
i = 1
x = Target.Row
For b = 2 To 12
i = i + 1
If s1.Cells(c.Row + i - 1, c.Column) = "" Then i = i + 1
Cells(Target.Row, b).Value = s1.Cells(c.Row + i - 1, c.Column + 4).Value
Next:
Exit Do
End If
            Set c = .FindNext(c)
If c Is Nothing Then Exit Do
        Loop While Not c Is Nothing And c.Address <> f
    End If
End With
End Sub[/SIZE]

 

[ultraslan38080]

Merhaba
Sayfada 11. satırdaki gibi boşluklar varmış dikkat etmemişiz
Kodlar "Sayfa2" vba penceresindedir
Aşağıdaki gibi değişip deneyiniz

[SIZE="2"]Private Sub Worksheet_Change(ByVal Target As Range)
If Selection.Cells.Count <> 1 Then Exit Sub
If Target.Column <> 1 Or Target.Value = "" Then Exit Sub

Set s1 = Sheets("Sayfa1")
With s1.Cells
    Set c = .Find("Okul No", LookIn:=xlValues, lookat:=xlPart)

    If Not c Is Nothing Then
        f = c.Address
        Do
If s1.Cells(c.Row, c.Column + 4).Text = Target.Text Then
i = 1
x = Target.Row
For b = 2 To 12
i = i + 1
If s1.Cells(c.Row + i - 1, c.Column) = "" Then i = i + 1
Cells(Target.Row, b).Value = s1.Cells(c.Row + i - 1, c.Column + 4).Value
Next:
Exit Do
End If
            Set c = .FindNext(c)
If c Is Nothing Then Exit Do
        Loop While Not c Is Nothing And c.Address <> f
    End If
End With
End Sub[/SIZE]

Çok teşekkür ediyorum sağolun. Özelden size mesaj yolladım ancak kotanız dolu olduğu için mesajın gidemediği uyarısı aldım.