• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Diğer sayfaya alt alta veri aktarma

Katılım
10 Kasım 2006
Mesajlar
399
Excel Vers. ve Dili
microsoft office 2007-2010-2013-2019-2021
Arkadaşlar sizden istediğim yardım, sarı renkli olan verilerin yani B11,C11,K8 ve Q8 deki verilerin aktar butonuna tıklayarak LİSTE sayfasına alt alta aktarmasıdır. Yanlış veri aktırımı yapılırsa da SİL butonuna tıklayarak en son eklenen verinin LİSTE sayfasından silinmesi gerekiyor.
Yardımlarınız için şimdiden teşekkür ederim.
 

Ekli dosyalar

Son düzenleme:
Merhaba.
Aşağıdaki KODları boş bir modüle yapıştırın.
Düğmelere tek tek sağ tıklayıp MAKRO ATA'yı seçin ve ilgili kod adını seçerek işlemi tamamlayın.
Kod:
[B][COLOR="Blue"]Sub AKTAR()[/COLOR][/B]
Dim a As Worksheet: Set a = Sheets("ANASAYFA")
Dim l As Worksheet: Set l = Sheets("LİSTE")
If a.Cells(11, 2) = "" Or a.Cells(11, 3) = "" Or a.Cells(8, 11) = "" Or a.Cells(8, 11) = "" Then
    MsgBox "TÜM ALANLAR DOLDURULMADAN KAYIT YAPILAMAZ.": Exit Sub
End If
satır = l.[A65536].End(3).Row + 1
    l.Cells(satır, 1) = satır - 2
    l.Cells(satır, 2) = a.Cells(11, 2): l.Cells(satır, 3) = a.Cells(11, 3)
    l.Cells(satır, 4) = a.Cells(8, 11): l.Cells(satır, 5) = a.Cells(8, 17)
[COLOR="Red"]    a.Cells(11, 2) = "": a.Cells(11, 3) = "": a.Cells(8, 11) = "": a.Cells(8, 17) = ""[/COLOR]
    a.Cells(11, 1) = satır - 1
MsgBox "KAYIT TAMAM"
[B][COLOR="Blue"]End Sub

Sub SİL()[/COLOR][/B]
Dim a As Worksheet: Set a = Sheets("ANASAYFA")
Dim l As Worksheet: Set l = Sheets("LİSTE")
If l.[A65536].End(3).Row = 2 Then Exit Sub
If a.Cells(11, 2) <> "" Or a.Cells(11, 3) <> "" Or a.Cells(8, 11) <> "" Or a.Cells(8, 11) <> "" Then
    MsgBox "BU SAYFADAKİ ALANLARIN TÜMÜ BOŞ OLMADAN SİLME İŞLEMİ YAPILAMAZ.": Exit Sub
End If
satır = l.[A65536].End(3).Row
    a.Cells(11, 1) = l.Cells(satır, 1)
    a.Cells(11, 2) = l.Cells(satır, 2): a.Cells(11, 3) = l.Cells(satır, 3)
    a.Cells(8, 11) = l.Cells(satır, 4): a.Cells(8, 17) = l.Cells(satır, 5)
    l.Cells(satır, 1) = "": l.Range("A" & satır & ":E" & satır) = ""
MsgBox "SON KAYIT SİLİNEREK BU SAYFAYA GETİRİLDİ."
[B][COLOR="Blue"]End Sub[/COLOR][/B]
 
Son düzenleme:
Ömer bey emeğinize sağlık ancak aktarma işlemini yapınca ANASAYFA daki elle girmiş olduğum verileri siliyor, verilerin silinmemesi gerekiyor gerekirse ben kendim silmeliyim. Bu konuda yardımcı olursanız sevinirim.
 
Yukarıdaki cevabımda kırmızı renklendirdiğim satırı silin veya satırın sol başına TEK TIRNAK işareti ekleyin.
 
Teşekkür ederim emeğinize sağlık
 
Geri
Üst