Kayıt

[eminuslu]

Sevgili dostlar dün sormuş olduğum sorumu her halde iyi anlatamadığımdan dolayı cevap alamadım soruyu tekrar anlaşılır hale getirerek tekrar sizlerden yardım istiyorum soru ve önerilerim ekteki dosyam içerisinde belirtilmiştir hepinize teşekkürler

 

[N.Ziya Hiçdurmaz]

yanıt

Sub aktar()
Dim sat, son, sira As Long
With Sayfa1
If .[d2] = "" Then
MsgBox "Önce bir veri girmelisiniz.", vbInformation
Exit Sub
End If
For sat = 2 To Sayfa2.Cells(65536, "e").End(xlUp).Row
If Sayfa2.Cells(sat, "e") = .[d5] Then
MsgBox "Bu isim daha önce kaydedilmiş.", vbInformation
Exit Sub
End If
Next
son = Sayfa2.Cells(65536, "b").End(xlUp).Row + 1
Sayfa2.Cells(son, "b") = .[d2]
Sayfa2.Cells(son, "c") = .[d3]
Sayfa2.Cells(son, "d") = .[d4]
Sayfa2.Cells(son, "e") = .[d5]
Sayfa2.Cells(son, "f") = .[d6]
Sayfa2.Cells(son, "g") = .[d7]
Sayfa2.Cells(son, "h") = .[d8]
Sayfa2.Cells(son, "ı") = .[d9]
End With
With Sayfa2
For sira = 2 To .Cells(65536, "b").End(xlUp).Row
.Cells(sira, "a") = sira - 1
Next
End With
End Sub

Sub temizle()
Dim sat, sira As Long
With Sayfa1
For sat = Sayfa2.Cells(65536, "e").End(xlUp).Row To 2 Step -1
If ActiveCell = .[d5] Then
.[d2:d9].ClearContents
End If
If ActiveCell = Sayfa2.Cells(sat, "e") Then
Sayfa2.Cells(sat, "e").EntireRow.Delete
End If
Next
End With
With Sayfa2
For sira = 2 To .Cells(65536, "b").End(xlUp).Row
.Cells(sira, "a") = sira - 1
Next
End With
End Sub

 

[halit3]

Sevgili dostlar dün sormuş olduğum sorumu her halde iyi anlatamadığımdan dolayı cevap alamadım soruyu tekrar anlaşılır hale getirerek tekrar sizlerden yardım istiyorum soru ve önerilerim ekteki dosyam içerisinde belirtilmiştir hepinize teşekkürler

alternatif olarak bende dosyayı ekliyorum.

 

[eminuslu]

Sevgili N.Ziya Hiçdurmaz bey ve Halit3 bey dosyalar tam istediğim şekilde olmuş Allah razı olsun ne muradınız varsa versin kim birinin sıkıntısını giderirse inancımıza göre Allahda onun sıkıntısını giderir teşekkürler