Yan sayfadan veri alma.

sward175

Özel Üye
Katılım
4 Şubat 2011
Mesajlar
1,112
Excel Vers. ve Dili
Excel Vers. ve Dili:
Microsoft Office 365 Tr 64 Bit
Altın Üyelik Bitiş Tarihi
04-06-2024
Herkese Merhabalar,

Ekli dosyada 1 aylık çalışma programı yazıyorum.
Çalışma çizelgesi sayfasına haftalık olarak çalışma çizelgesi oluşturmak için yardımlarınızı rica ederim.
Saygılarımla,
sward175
 

Ekli dosyalar

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Aşağıdaki makroyu deneyiniz:

PHP:
Sub haftavar()
Set s1 = Sheets("VARDİYA")
Set s2 = Sheets("Çalışma Çizelgesi")

songun = s2.Cells(Rows.Count, "A").End(3).Row
sonper = s1.Cells(Rows.Count, "B").End(3).Row - 19

s2.[C6:R53].ClearContents

For gun = 6 To 48 Step 7
    ht = 0: yi = 0: vd = 0: r = 0: mi = 0: rt = 0: ui = 0: bi = 0: oi = 0
    var1 = 0: var2 = 0: var3 = 0: var4 = 0: var5 = 0: var6 = 0: var7 = 0
    
    sut = WorksheetFunction.Match(s2.Cells(gun, "A"), s1.[A3:AG3], 0)
    For kisi = 4 To sonper
        If s1.Cells(kisi, "B") <> "" Then
            If s1.Cells(kisi, sut) = "HT" Then
                s2.Cells(gun + ht, "J") = s1.Cells(kisi, "B")
                ht = ht + 1
            End If
            If s1.Cells(kisi, sut) = "Yİ" Then
                s2.Cells(gun + yi, "K") = s1.Cells(kisi, "B")
                yi = yi + 1
            End If
            If s1.Cells(kisi, sut) = "VD" Then
                s2.Cells(gun + vd, "L") = s1.Cells(kisi, "B")
                vd = vd + 1
            End If
            If s1.Cells(kisi, sut) = "R" Then
                s2.Cells(gun + r, "M") = s1.Cells(kisi, "B")
                r = r + 1
            End If
            If s1.Cells(kisi, sut) = "Mİ" Then
                s2.Cells(gun + mi, "N") = s1.Cells(kisi, "B")
                mi = mi + 1
            End If
            If s1.Cells(kisi, sut) = "RT" Then
                s2.Cells(gun + rt, "O") = s1.Cells(kisi, "B")
                rt = rt + 1
            End If
            If s1.Cells(kisi, sut) = "Üİ" Then
                s2.Cells(gun + ui, "P") = s1.Cells(kisi, "B")
                ui = ui + 1
            End If
            If s1.Cells(kisi, sut) = "Bİ" Then
                s2.Cells(gun + bi, "Q") = s1.Cells(kisi, "B")
                bi = bi + 1
            End If
            If s1.Cells(kisi, sut) = "Öİ" Then
                s2.Cells(gun + oi, "R") = s1.Cells(kisi, "B")
                oi = oi + 1
            End If
            
            If s1.Cells(kisi, sut) = s2.[C5] Then
                s2.Cells(gun + var1, "C") = s1.Cells(kisi, "B")
                var1 = var1 + 1
            End If
            If s1.Cells(kisi, sut) = s2.[D5] Then
                s2.Cells(gun + var2, "D") = s1.Cells(kisi, "B")
                var2 = var2 + 1
            End If
            If s1.Cells(kisi, sut) = s2.[E5] Then
                s2.Cells(gun + var3, "E") = s1.Cells(kisi, "B")
                var3 = var3 + 1
            End If
            If s1.Cells(kisi, sut) = s2.[F5] Then
                s2.Cells(gun + var4, "F") = s1.Cells(kisi, "B")
                var4 = var4 + 1
            End If
            If s1.Cells(kisi, sut) = s2.[G5] Then
                s2.Cells(gun + var5, "G") = s1.Cells(kisi, "B")
                var5 = var5 + 1
            End If
            If s1.Cells(kisi, sut) = s2.[H5] Then
                s2.Cells(gun + var6, "H") = s1.Cells(kisi, "B")
                var6 = var6 + 1
            End If
            If s1.Cells(kisi, sut) = s2.[I5] Then
                s2.Cells(gun + var7, "I") = s1.Cells(kisi, "B")
                var7 = var7 + 1
            End If
        End If
    Next
Next
                
End Sub
 

sward175

Özel Üye
Katılım
4 Şubat 2011
Mesajlar
1,112
Excel Vers. ve Dili
Excel Vers. ve Dili:
Microsoft Office 365 Tr 64 Bit
Altın Üyelik Bitiş Tarihi
04-06-2024
YUSUF44,
Çok Çok ama Çok Teşekkürler ediyorum.
Sağ olun,
sward175
 

sward175

Özel Üye
Katılım
4 Şubat 2011
Mesajlar
1,112
Excel Vers. ve Dili
Excel Vers. ve Dili:
Microsoft Office 365 Tr 64 Bit
Altın Üyelik Bitiş Tarihi
04-06-2024
Herkese Merhabalar,
Sayın, YUSUF44, Arkadaşımızın vermiş olduğu kodlar gayet güzel çalışıyor.
Çalışan sayısının artmasıyla formatı değiştirmem gerekti.
Bu şekli ile makroya yardım edecek arkadaşlara teşekkürlerimi sunarım.
Saygılarımla,
sward175
 

Ekli dosyalar

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Aşağıdaki makroyu deneyiniz:

PHP:
Sub haftavar()
Set s1 = Sheets("VARDİYA")
Set s2 = Sheets("Çalışma Listesi")

sonper = s1.Cells(Rows.Count, "A").End(3).Row

s2.Range("C6:AN45").ClearContents
s2.Range("C50:AN89").ClearContents

For gun1 = 3 To 29 Step 13
    For gun2 = 3 To 47 Step 44
        ht = 0: yi = 0: vd = 0: r = 0: mi = 0: rt = 0: ui = 0: bi = 0: oi = 0
        var1 = 0: var2 = 0: var3 = 0
        
        sut = WorksheetFunction.Match(s2.Cells(gun2, gun1), s1.[A3:AG3], 0)
        For kisi = 4 To sonper
            If s1.Cells(kisi, "B") <> "" Then
                If s1.Cells(kisi, sut) = "HT" Then
                    s2.Cells(gun2 + 3 + ht, gun1 + 3) = s1.Cells(kisi, "B")
                    ht = ht + 1
                End If
                If s1.Cells(kisi, sut) = "Yİ" Then
                    s2.Cells(gun2 + 3 + yi, gun1 + 4) = s1.Cells(kisi, "B")
                    yi = yi + 1
                End If
                If s1.Cells(kisi, sut) = "VD" Then
                    s2.Cells(gun2 + 3 + vd, gun1 + 5) = s1.Cells(kisi, "B")
                    vd = vd + 1
                End If
                If s1.Cells(kisi, sut) = "R" Then
                    s2.Cells(gun2 + 3 + r, gun1 + 6) = s1.Cells(kisi, "B")
                    r = r + 1
                End If
                If s1.Cells(kisi, sut) = "Mİ" Then
                    s2.Cells(gun2 + 3 + mi, gun1 + 7) = s1.Cells(kisi, "B")
                    mi = mi + 1
                End If
                If s1.Cells(kisi, sut) = "RT" Then
                    s2.Cells(gun2 + 3 + rt, gun1 + 8) = s1.Cells(kisi, "B")
                    rt = rt + 1
                End If
                If s1.Cells(kisi, sut) = "Üİ" Then
                    s2.Cells(gun2 + 3 + ui, gun1 + 9) = s1.Cells(kisi, "B")
                    ui = ui + 1
                End If
                If s1.Cells(kisi, sut) = "Bİ" Then
                    s2.Cells(gun2 + 3 + bi, gun1 + 10) = s1.Cells(kisi, "B")
                    bi = bi + 1
                End If
                If s1.Cells(kisi, sut) = "Öİ" Then
                    s2.Cells(gun2 + 3 + oi, gun1 + 11) = s1.Cells(kisi, "B")
                    oi = oi + 1
                End If
                
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1) Then
                    s2.Cells(gun2 + 3 + var1, gun1) = s1.Cells(kisi, "B")
                    var1 = var1 + 1
                End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1 + 1) Then
                    s2.Cells(gun2 + 3 + var2, gun1 + 1) = s1.Cells(kisi, "B")
                    var2 = var2 + 1
                End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1 + 2) Then
                    s2.Cells(gun2 + 3 + var3, gun1 + 2) = s1.Cells(kisi, "B")
                    var3 = var3 + 1
                End If
            End If
        Next
    Next
Next
                
End Sub
 

sward175

Özel Üye
Katılım
4 Şubat 2011
Mesajlar
1,112
Excel Vers. ve Dili
Excel Vers. ve Dili:
Microsoft Office 365 Tr 64 Bit
Altın Üyelik Bitiş Tarihi
04-06-2024
Sayın, YUSUF44,
Teşekkürlerimi bir borç bilirim.
Sağ olun.
sward175
 

sward175

Özel Üye
Katılım
4 Şubat 2011
Mesajlar
1,112
Excel Vers. ve Dili
Excel Vers. ve Dili:
Microsoft Office 365 Tr 64 Bit
Altın Üyelik Bitiş Tarihi
04-06-2024
Herkese Merhabalar,
Sayın, YUSUF44, Arkadaşımızın vermiş olduğu kodlar ile çalışıyorum.
Çalışan sayısının artmasıyla formata değişiklik gerekti.
Ekteki biçimi ile makroya yardım edecek arkadaşlara teşekkürlerimi sunarım.
Saygılarımla,
sward175
 

Ekli dosyalar

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Sanıyorum sorun sadece döngü aralığının değiştirilmesiyle ilgili. Bunu sizin de yapabilmeniz lazımdı aslında, biraz dikkat ve gayretle yapabilirdiniz bence.

Aşağıdaki makro uygun mu?

PHP:
Sub haftavar()
Set s1 = Sheets("VARDİYA")
Set s2 = Sheets("Çalışma Listesi")

sonper = s1.Cells(Rows.Count, "A").End(3).Row

s2.Range("C6:AN65").ClearContents
s2.Range("C70:AN129").ClearContents

For gun1 = 3 To 29 Step 13
    For gun2 = 3 To 67 Step 64
        ht = 0: yi = 0: vd = 0: r = 0: mi = 0: rt = 0: ui = 0: bi = 0: oi = 0
        var1 = 0: var2 = 0: var3 = 0
        
        sut = WorksheetFunction.Match(s2.Cells(gun2, gun1), s1.[A3:AG3], 0)
        For kisi = 4 To sonper
            If s1.Cells(kisi, "B") <> "" Then
                If s1.Cells(kisi, sut) = "HT" Then
                    s2.Cells(gun2 + 3 + ht, gun1 + 3) = s1.Cells(kisi, "B")
                    ht = ht + 1
                End If
                If s1.Cells(kisi, sut) = "Yİ" Then
                    s2.Cells(gun2 + 3 + yi, gun1 + 4) = s1.Cells(kisi, "B")
                    yi = yi + 1
                End If
                If s1.Cells(kisi, sut) = "VD" Then
                    s2.Cells(gun2 + 3 + vd, gun1 + 5) = s1.Cells(kisi, "B")
                    vd = vd + 1
                End If
                If s1.Cells(kisi, sut) = "R" Then
                    s2.Cells(gun2 + 3 + r, gun1 + 6) = s1.Cells(kisi, "B")
                    r = r + 1
                End If
                If s1.Cells(kisi, sut) = "Mİ" Then
                    s2.Cells(gun2 + 3 + mi, gun1 + 7) = s1.Cells(kisi, "B")
                    mi = mi + 1
                End If
                If s1.Cells(kisi, sut) = "RT" Then
                    s2.Cells(gun2 + 3 + rt, gun1 + 8) = s1.Cells(kisi, "B")
                    rt = rt + 1
                End If
                If s1.Cells(kisi, sut) = "Üİ" Then
                    s2.Cells(gun2 + 3 + ui, gun1 + 9) = s1.Cells(kisi, "B")
                    ui = ui + 1
                End If
                If s1.Cells(kisi, sut) = "Bİ" Then
                    s2.Cells(gun2 + 3 + bi, gun1 + 10) = s1.Cells(kisi, "B")
                    bi = bi + 1
                End If
                If s1.Cells(kisi, sut) = "Öİ" Then
                    s2.Cells(gun2 + 3 + oi, gun1 + 11) = s1.Cells(kisi, "B")
                    oi = oi + 1
                End If
                
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1) Then
                    s2.Cells(gun2 + 3 + var1, gun1) = s1.Cells(kisi, "B")
                    var1 = var1 + 1
                End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1 + 1) Then
                    s2.Cells(gun2 + 3 + var2, gun1 + 1) = s1.Cells(kisi, "B")
                    var2 = var2 + 1
                End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1 + 2) Then
                    s2.Cells(gun2 + 3 + var3, gun1 + 2) = s1.Cells(kisi, "B")
                    var3 = var3 + 1
                End If
            End If
        Next
    Next
Next
                
End Sub
 

sward175

Özel Üye
Katılım
4 Şubat 2011
Mesajlar
1,112
Excel Vers. ve Dili
Excel Vers. ve Dili:
Microsoft Office 365 Tr 64 Bit
Altın Üyelik Bitiş Tarihi
04-06-2024
Sayın, YUSUF44.
Çok teşekkür ederim.
Makro bilgim sıfıra yakın olduğu için yardım ihtiyacı duyuyorum, Uyarınızı anladım daha fazla satırlı olursa halledeceğim galiba.
Yine de çok teşekkür ediyorum.
Sağ Olun, sward175
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Sadece o değil, ayrıca VD isimli sütununuzu da iptal etmişsiniz. Lütfen bu değişikliklere dikkat edelim, hatanın nerde olduğunu buluncaya kadar yarım saat uğraştım.

Aşağıdaki makroyu deneyiniz:

PHP:
Sub haftavar()
Set s1 = Sheets("VARDİYA")
Set s2 = Sheets("Çalışma Listesi")

sonper = s1.Cells(Rows.Count, "A").End(3).Row

s2.Range("C6:AN65").ClearContents
s2.Range("C70:AN129").ClearContents

For gun1 = 3 To 29 Step 13
    For gun2 = 3 To 67 Step 64
        ht = 0: yi = 0: r = 0: mi = 0: rt = 0: ui = 0: bi = 0: oi = 0
        var1 = 0: var2 = 0: var3 = 0: var4 = 0
        
        sut = WorksheetFunction.Match(s2.Cells(gun2, gun1), s1.[A3:AN3], 0)
        For kisi = 4 To sonper
            If s1.Cells(kisi, "B") <> "" Then
                If s1.Cells(kisi, sut) = "HT" Then
                    s2.Cells(gun2 + 3 + ht, gun1 + 4) = s1.Cells(kisi, "B")
                    ht = ht + 1
                End If
                If s1.Cells(kisi, sut) = "Yİ" Then
                    s2.Cells(gun2 + 3 + yi, gun1 + 5) = s1.Cells(kisi, "B")
                    yi = yi + 1
                End If
                If s1.Cells(kisi, sut) = "R" Then
                    s2.Cells(gun2 + 3 + r, gun1 + 6) = s1.Cells(kisi, "B")
                    r = r + 1
                End If
                If s1.Cells(kisi, sut) = "Mİ" Then
                    s2.Cells(gun2 + 3 + mi, gun1 + 7) = s1.Cells(kisi, "B")
                    mi = mi + 1
                End If
                If s1.Cells(kisi, sut) = "RT" Then
                    s2.Cells(gun2 + 3 + rt, gun1 + 8) = s1.Cells(kisi, "B")
                    rt = rt + 1
                End If
                If s1.Cells(kisi, sut) = "Üİ" Then
                    s2.Cells(gun2 + 3 + ui, gun1 + 9) = s1.Cells(kisi, "B")
                    ui = ui + 1
                End If
                If s1.Cells(kisi, sut) = "Bİ" Then
                    s2.Cells(gun2 + 3 + bi, gun1 + 10) = s1.Cells(kisi, "B")
                    bi = bi + 1
                End If
                If s1.Cells(kisi, sut) = "Öİ" Then
                    s2.Cells(gun2 + 3 + oi, gun1 + 11) = s1.Cells(kisi, "B")
                    oi = oi + 1
                End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1) Then
                    s2.Cells(gun2 + 3 + var1, gun1) = s1.Cells(kisi, "B")
                    var1 = var1 + 1
                End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1 + 1) Then
                    s2.Cells(gun2 + 3 + var2, gun1 + 1) = s1.Cells(kisi, "B")
                    var2 = var2 + 1
                End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1 + 2) Then
                    s2.Cells(gun2 + 3 + var3, gun1 + 2) = s1.Cells(kisi, "B")
                    var3 = var3 + 1
                End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1 + 3) Then
                    s2.Cells(gun2 + 3 + var3, gun1 + 3) = s1.Cells(kisi, "B")
                    var4 = var4 + 1
                End If
            End If
        Next
    Next
Next
                
End Sub
 

sward175

Özel Üye
Katılım
4 Şubat 2011
Mesajlar
1,112
Excel Vers. ve Dili
Excel Vers. ve Dili:
Microsoft Office 365 Tr 64 Bit
Altın Üyelik Bitiş Tarihi
04-06-2024
Sayın, YUSUF44,
Çok güzel gayet iyi çalışıyor.
Her şey için çık çok teşekkür ederim.
Saygılarımla,
sward175
 

sward175

Özel Üye
Katılım
4 Şubat 2011
Mesajlar
1,112
Excel Vers. ve Dili
Excel Vers. ve Dili:
Microsoft Office 365 Tr 64 Bit
Altın Üyelik Bitiş Tarihi
04-06-2024
Herkese Günaydın.
Sayın, YUSUF44 Arkadaşımızın yardımı ile geliştirmeye çalıştığım vardiya sayfasından çalışma listesi sayfasına veri aktarırken makroda aşağıdaki hatayı alıyorum.
Konu hakkında yardımlarınızı rica ederim.
Saygılarımla,
sward175

sut = WorksheetFunction.Match(s2.Cells(gun2, gun1), s1.[A3:AW3], 0)
 

Ekli dosyalar

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Çalışma Listesi sayfasında Kasım ayına ait günler varken, Vardiya sayfasında Ocak ayının verileri olmasından kaynaklanıyor olabilir mi? :eek:
 

sward175

Özel Üye
Katılım
4 Şubat 2011
Mesajlar
1,112
Excel Vers. ve Dili
Excel Vers. ve Dili:
Microsoft Office 365 Tr 64 Bit
Altın Üyelik Bitiş Tarihi
04-06-2024
Merhaba, YUSUF44,
Tarihleri değiştirdim ama gene aynı hatayı listenin bir bölümünü dizerek verdi.
sward175
 

Ekli dosyalar

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Farkında mısınız bilmiyorum ama bir önceki dosyanızda vardiya sayınızın artması nedeniyle kodlarda günceleme yapmıştık. Şimdi bir önceki dosyanızla şimdiki dosyanızı karşılaştırdığımda görüyorum ki yine değişiklik yapmışsınız. Bir önceki dosyanızda 4 vardiya 8 de özel durum varken şimdiki dosyanızda 6 vardiya 9 özel durum var.

Bir önceki durumda vardiya düzeni değişince oluşan hatanın farkındayken şimdi bunu farketmemiş olmanız şaşırtıcı. Kodlarda yeni eklenen sütunlara göre güncelleme yapılması gerekir. Ancak emeğimizin boşa gitmemesi adına bu dosyanın artık son hali olduğuna emin misiniz? Yarın başka vardiya ya da özel durumlar ekleyip çıkartmayacaksınız değil mi?
 

sward175

Özel Üye
Katılım
4 Şubat 2011
Mesajlar
1,112
Excel Vers. ve Dili
Excel Vers. ve Dili:
Microsoft Office 365 Tr 64 Bit
Altın Üyelik Bitiş Tarihi
04-06-2024
Merhaba, Sayın, YUSUF44,
Gerçekten özür dilerim ne diyeyim ki sürekli değişiklik gerektiren bir durum olduğu için sizleri meşgul ediyorum. Hal böyle olunca doğal ki istekler artıyor, Bilesiniz ki bu konuda son isteğimdir yardımınız.
İlginize teşekkür ediyorum.
saygılarımla,
sward175
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Bazı güncellemeleri yapmışsınız ama bazıları eksik kalmış, özellikle for next döngüsünün step yani adım aralığı olmamış, bir de HT ve diğer durumlar için eklenecek sütun sayısını 1 fazla belirlemişsiniz. Onları düzelttim:

PHP:
Sub haftavar()
Set s1 = Sheets("VARDİYA")
Set s2 = Sheets("Çalışma Listesi")

sonper = s1.Cells(Rows.Count, "A").End(3).Row

s2.Range("C6:AW65").ClearContents
s2.Range("C70:AW129").ClearContents

For gun1 = 3 To 35 Step 16
    For gun2 = 3 To 67 Step 64
        ht = 0: yi = 0: vd = 0: r = 0: mi = 0: rt = 0: ui = 0: bi = 0: oi = 0
        var1 = 0: var2 = 0: var3 = 0: var4 = 0: var5 = 0: var6 = 0
        sut = WorksheetFunction.Match(s2.Cells(gun2, gun1), s1.[A3:AW3], 0)
        For kisi = 6 To sonper
            If s1.Cells(kisi, "B") <> "" Then
                If s1.Cells(kisi, sut) = "HT" Then
                    s2.Cells(gun2 + 3 + ht, gun1 + 6) = s1.Cells(kisi, "B")
                    ht = ht + 1
                End If
                If s1.Cells(kisi, sut) = "Yİ" Then
                    s2.Cells(gun2 + 3 + yi, gun1 + 7) = s1.Cells(kisi, "B")
                    yi = yi + 1
                    End If
                If s1.Cells(kisi, sut) = "VD" Then
                    s2.Cells(gun2 + 3 + vd, gun1 + 8) = s1.Cells(kisi, "B")
                    vd = vd + 1
                End If
                If s1.Cells(kisi, sut) = "R" Then
                    s2.Cells(gun2 + 3 + r, gun1 + 9) = s1.Cells(kisi, "B")
                    r = r + 1
                End If
                If s1.Cells(kisi, sut) = "Mİ" Then
                    s2.Cells(gun2 + 3 + mi, gun1 + 10) = s1.Cells(kisi, "B")
                    mi = mi + 1
                End If
                If s1.Cells(kisi, sut) = "RT" Then
                    s2.Cells(gun2 + 3 + rt, gun1 + 11) = s1.Cells(kisi, "B")
                    rt = rt + 1
                End If
                If s1.Cells(kisi, sut) = "Üİ" Then
                    s2.Cells(gun2 + 3 + ui, gun1 + 12) = s1.Cells(kisi, "B")
                    ui = ui + 1
                End If
                If s1.Cells(kisi, sut) = "Bİ" Then
                    s2.Cells(gun2 + 3 + bi, gun1 + 13) = s1.Cells(kisi, "B")
                    bi = bi + 1
                End If
                If s1.Cells(kisi, sut) = "Öİ" Then
                    s2.Cells(gun2 + 3 + oi, gun1 + 14) = s1.Cells(kisi, "B")
                    oi = oi + 1
                End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1) Then
                    s2.Cells(gun2 + 3 + var1, gun1) = s1.Cells(kisi, "B")
                    var1 = var1 + 1
                End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1 + 1) Then
                    s2.Cells(gun2 + 3 + var2, gun1 + 1) = s1.Cells(kisi, "B")
                    var2 = var2 + 1
                End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1 + 2) Then
                    s2.Cells(gun2 + 3 + var3, gun1 + 2) = s1.Cells(kisi, "B")
                    var3 = var3 + 1
                End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1 + 3) Then
                    s2.Cells(gun2 + 3 + var3, gun1 + 3) = s1.Cells(kisi, "B")
                    var4 = var4 + 1
                    End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1 + 4) Then
                    s2.Cells(gun2 + 3 + var3, gun1 + 4) = s1.Cells(kisi, "B")
                    var5 = var5 + 1
                    End If
                If s1.Cells(kisi, sut) = s2.Cells(gun2 + 2, gun1 + 5) Then
                    s2.Cells(gun2 + 3 + var3, gun1 + 5) = s1.Cells(kisi, "B")
                    var6 = var6 + 1
                End If
            End If
        Next
    Next
Next         
End Sub
 

sward175

Özel Üye
Katılım
4 Şubat 2011
Mesajlar
1,112
Excel Vers. ve Dili
Excel Vers. ve Dili:
Microsoft Office 365 Tr 64 Bit
Altın Üyelik Bitiş Tarihi
04-06-2024
Sayın, YUSUF44,
Çok teşekkür ediyorum.
Elleriniz dert görmesin.
Kalın sağlıcakla
sward175
 
Üst