Başka sayfadan Diğer sayfaya Veri Aktarımı

Katılım
5 Nisan 2023
Mesajlar
22
Excel Vers. ve Dili
2007-2010-2013 türkçe
Altın Üyelik Bitiş Tarihi
05-04-2024
Üstadlarım excel örnekte detaylı yazdım başka sayfadan verileri diğer sayfaya sıralı şekilde alınması için yardımınıza ihtiyacım var teşekkür ederim iyi akşamlar dilerim

benim için çok önemli kendim çok çalıştım ama sürekli hata verdi
 

Ekli dosyalar

sbayyigit

Altın Üye
Katılım
11 Aralık 2004
Mesajlar
411
Excel Vers. ve Dili
Ms Office Pro Plus 2019
Altın Üyelik Bitiş Tarihi
23-02-2026
Makro kaydet ile yaptım. Yanlış anlamadıysam işinizi görecektir
 

Ekli dosyalar

AdemCan

Altın Üye
Destek Ekibi
Katılım
1 Eylül 2008
Mesajlar
1,386
Excel Vers. ve Dili
2019 TR
Merhaba, hazırlamışken alternatif örnek olsun :)
Liste sayfasından Atama sayfasına aktarılan kişi isimlerinin yanına yani C sütununa "+" simgesi ekleniyor. Bu kişiler tekrar atama listesine gelmiyor.
Atama listesini temizlemek için kod kullanıyorsunuzdur, bu koda liste sayfası C sütununu da eklemelisiniz ki "+" simgesi silinsin.
Kod:
Sub test_dagit()
Dim atama As Worksheet, liste As Worksheet, lson As Long, satir As Long, i As Byte, s As Byte
Set atama = Sayfa1
Set liste = Sayfa2: lson = liste.Range("A" & Rows.Count).End(3).Row
s = 2
1:
For i = 3 To 12
2:
    satir = WorksheetFunction.RandBetween(2, lson)
    If liste.Range("C" & satir) <> "+" Then
        atama.Cells(i, s) = liste.Range("A" & satir)
        atama.Cells(i, s + 1) = liste.Range("B" & satir)
        liste.Range("C" & satir) = "+"
    Else
        say = WorksheetFunction.CountIf(liste.Range("C2:C" & lson), "+")
        If say = lson - 1 Then
            GoTo bitir
        Else
            GoTo 2
        End If
    End If
    
    If i = 12 Then
    ss = atama.Cells(2, Columns.Count).End(1).Column
    If s + 1 = ss Then GoTo bitir
    grup = atama.Cells(1, s)
    soru = MsgBox(grup & " tamamlandı, diğer gruba geçmek ister misiniz?", vbQuestion + vbYesNo, "")
        If soru = vbYes Then
            s = s + 2: GoTo 1
        End If
    End If
Next
bitir:
Set atama = Nothing: Set liste = Nothing
lson = 0: satir = 0: s = 0: i = 0
End Sub
 
Katılım
5 Nisan 2023
Mesajlar
22
Excel Vers. ve Dili
2007-2010-2013 türkçe
Altın Üyelik Bitiş Tarihi
05-04-2024
hepinize çok teşekkür ederim hocalarım ilaç gibi geldiniz Allah razı olsun.
 
Katılım
5 Nisan 2023
Mesajlar
22
Excel Vers. ve Dili
2007-2010-2013 türkçe
Altın Üyelik Bitiş Tarihi
05-04-2024
sayın @AdemCan hocam peki birkaç değişiklik sorsam yardımcı olabilir misiniz diğer arkadaşların yaptıkları da çok güzel ama arasında şuan benim işimi çözecek olan sizin yazdığınız. yeni bir örnek ekledim sadece alan genişletilecek müsait olursanız bakabilir misiniz
 

Ekli dosyalar

Katılım
5 Nisan 2023
Mesajlar
22
Excel Vers. ve Dili
2007-2010-2013 türkçe
Altın Üyelik Bitiş Tarihi
05-04-2024
@muygun hocam sizin içinde bir örnek yaptım belki çok oldum biraz özür dilerim ama gerçekten çok dua ederim elimden başka birşey gelmiyor şuan rica etsem müsait olursanız bakabilir misiniz
 

Ekli dosyalar

Katılım
5 Nisan 2023
Mesajlar
22
Excel Vers. ve Dili
2007-2010-2013 türkçe
Altın Üyelik Bitiş Tarihi
05-04-2024
@muygun hocam Allah razı olsun valla tek kelimeyle çok çok güzel olmuş inan nasıl teşekkür etsem azdır sana. ama son bir isteğim olsa hocam hazırlığa basınca ab sutununu da siliyor ya onu kaldırabilir miyiz yani c ve sonrası silinse olur geri kalan her şey on numara olmuş sayın hocam
 
Katılım
5 Nisan 2023
Mesajlar
22
Excel Vers. ve Dili
2007-2010-2013 türkçe
Altın Üyelik Bitiş Tarihi
05-04-2024
@muygun gerek kalmadı tekrar hocam geliştiriciden yaptım tekrardan çok teşekkür ederim Allah razı olsun
 
Üst