Altalta girilen verileri başka sayfada yanyana listeleme

[erkanersoy]

Değerli arkadaşlar, örneğin A sayfasında altalta 6-7 hücreye girdiğim bilgilerin B sayfasında yanyana yazmasını istiyorum. bununla ilgili örnek kod bilen arkadaşlar varsa lütfen yardım...
Kolay gelsin...
Örnek dosya Ek'tedir.

 

[Necdet]

Merhaba,

Aşağıdaki kodları kullanabilirsiniz.

Sub Aktar()
Dim sv As Worksheet
Dim SonSat As Long
Set sv = Sheets("VERİLER")
SonSat = sv.[A65536].End(3).Row + 1
Range("C6:C12").Copy
sv.Range("B" & SonSat).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
sv.Range("A" & SonSat) = SonSat - 3
Application.CutCopyMode = False
End Sub

 

[erkanersoy]

Merhaba,

Aşağıdaki kodları kullanabilirsiniz.

Sub Aktar()
Dim sv As Worksheet
Dim SonSat As Long
Set sv = Sheets("VERİLER")
SonSat = sv.[A65536].End(3).Row + 1
Range("C6:C12").Copy
sv.Range("B" & SonSat).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
sv.Range("A" & SonSat) = SonSat - 3
Application.CutCopyMode = False
End Sub

Elinize sağlık harika olmuş, tam istediğim gibi. birşey daha sormak istiyorum size. aktarılacak bilgilerin içinde Tutanak no diye bir bilgi var. eğer bu hücredeki değer veriler sayfasında varsa kullanıcıya bunun zaten olduğunu yenisinin eklenip eklenmiyeceğini sormasını bir msjbox la yapabilirmiyiz. yinede kaydet dediğimde eskisini bozmadan yeni bir kayıtmuş gibi kaydetmeli kaydetme dediğimde ise eski bilgiyi korumalı. Bu mümkün mü?
Teşekkür ederim.
Örnek dosya Ek tedir.

 

[Necdet]

Merhaba,

Sub Aktar()
Dim sv As Worksheet
Dim SonSat As Long
Dim c As Range
Dim Evet As String
Set sv = Sheets("VERİLER")
Evet = vbYes
Application.ScreenUpdating = False
Set c = sv.Range("B:B").Find([C6], LookIn:=xlValues)
If Not c Is Nothing Then
    Evet = MsgBox([C6] & " Nolu Tutanak Var, Yeni Bir Kayıt Gibi Kaydetmek İster Misiniz?", vbYesNo)
End If
    If Evet = vbYes Then
        SonSat = sv.[A65536].End(3).Row + 1
        Range("C6:C14").Copy
        sv.Range("B" & SonSat).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
        sv.Range("A" & SonSat) = SonSat - 2
        Application.CutCopyMode = False
    End If
' kaydı tamamlanan bilgiyi sil..
Range("C6:C14").ClearContents
Range("C6").Select
Application.ScreenUpdating = True
End Sub

 

[erkanersoy]

Nejdet bey son gönderdiğiniz kodda aynı tutanak no girilirse soruyor bu kısım harika olmuş
ama normal yani tutanak no aynı olmayan sıradan bir kayıt girerken kaydet dedikten sonra kaydetmiyor. Acaba benbir yerde hatamı yapıyorum Teşekkür...

 

[Necdet]

Merhaba,

Bir taraftan iş yapıp diğer taraftan da soru yanıtlamaya kalkınca tek bir konuya yoğunlaşabilmişim

Yukarıdaki kodları ve dosyayı yeniledim, dener misiniz?

 

[erkanersoy]

Merhaba,

Bir taraftan iş yapıp diğer taraftan da soru yanıtlamaya kalkınca tek bir konuya yoğunlaşabilmişim

Yukarıdaki kodları ve dosyayı yeniledim, dener misiniz?

Zahmet ve ilginiz için çok teşekkür ederim. Kodun son hali harika tam istediğim gibi olmuş. Elinize emeğinize sağlık.

 

[Necdet]

Güle güle kullanınız.