Sayfadaki veri diğer sayfaya boş hücreden başlayarak aktarma

[ramazan_58]

Arkadaşlar ekte sunduğum belgenin bilgi girişi sayfasındaki bilgiler kütük sayfasındaki boş hücrelerden başlayarak bilgi aktarılmasını istiyorum.Yardımlarınız için şimdiden çok teşekkür ederim.

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin.

Sub aktar()
Application.ScreenUpdating = False
Set s1 = Sheets("bilgi girişi")
Set s2 = Sheets("kütük")
sonsat = s2.[c2].End(4).Row + 1
s1.[c2:c44].Copy
s2.Cells(sonsat, "c").PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
MsgBox "Veriler aktarılmıştır."
End Sub

 

[ramazan_58]

selamlar

Üstadım çok teşekkür ediyorum.Gönderdiğin kodlar mükemmel çalışıyor.Allah(C.C.)işlerinde kolaylık versin.

 

[ramazan_58]

selamlar

hocam aktar kodunu çalıştırdığımızda bilgi girişi sayfasındaki TC Kimlik numarası eğer kütük sayfasının f sütununda var ise uyarı verebilirmi.Yardımlarınız için şimdiden çok teşekkür ederim.

 

[ramazan_58]

selamlar

arkadaşlar yukarda ekteki belgede uyarı görüntülemesini istiyorum.Yardımlarınıza şimdiden teşekkür ederim.

 

[Korhan Ayhan]

Selamlar,

Sn. leventm beyin önerdiği kodu aşağıdaki şekilde değiştirip denermisiniz.

Sub Aktar()
    Application.ScreenUpdating = False
    Set S1 = Sheets("bilgi girişi")
    Set S2 = Sheets("kütük")
    sonsat = S2.[c2].End(4).Row + 1
    If WorksheetFunction.CountIf(S2.[F:F], S1.[C5]) > 0 Then
    MsgBox "Bu kayıt daha önce aktarılmıştır !", vbExclamation, "Dikkat !": Exit Sub: End If
    S1.[c2:c44].Copy
    S2.Cells(sonsat, "c").PasteSpecial Paste:=xlPasteValues, Transpose:=True
    Application.CutCopyMode = False
    MsgBox "Veriler aktarılmıştır."
End Sub

 

[ramazan_58]

Selamlar

Hocam teşekkür ediyorum ben de cevap alamayınca biraz uğraşarak forumdan da yararlanarak aşağıdaki kodları yazdım ve sorunu çözdükten sonra gönderdiğin kodlar aldım.Yaptığım çalışmayı aşağıya yazdım.Teşekkür ediyorum


Sub Aktar()
Application.ScreenUpdating = False
Set S1 = Sheets("bilgi girişi")
Set S2 = Sheets("kütük")
sonsat = S2.[c2].End(4).Row + 1
b = WorksheetFunction.CountIf(S2.Range("f1:f" & sonsat), S1.Cells(5, 3))
If b > 0 Then
z = MsgBox("Bu kayıt daha önce aktarılmıştır !", vbOKOnly + vbInformation, "İşlem Durduruldu")
Exit Sub
End If

S1.[c2:c44].Copy
S2.Cells(sonsat, "c").PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False

Sheets("Bilgi Girişi").Select
Range("C2:C44").Select
Selection.ClearContents
Range("C2").Select

MsgBox "Veriler aktarılmıştır."
End Sub