Veri Aktarma

[asdek]

Merhaba Arkadaşlar,

Ekteki Sayfa1 isim listesi mevcuttur, Bu isim listesinin en sağında işlem bölümü vardır orada G yazanları aktar butonu ile Sayfa2 deki şablona atabilir miyiz?
Saygılarımla.

 

[Ömer BARAN]

Merhaba.

Aşağıdaki kod'u kullanabilirsiniz.
Kod düğmeye her tıkladığınızda G kriterine uyan satırlardaki bilgileri
Sayfa2'ye ilk boş hücreden itibaren aktarır, atarılan satırlardaki G'leri AKTARILDI olarak değiştirir.
.

[FONT="Arial Narrow"][B]Sub Dikdörtgen_Tıklat()[/B]
Set s1 = Sheets("S"): Set s2 = Sheets("YAZDIR")
s1.Activate: On Error Resume Next: s1.ShowAllData
If Not s1.AutoFilterMode Then s1.Range("A3:U3").AutoFilter
s1.Range("A3:U65536").AutoFilter Field:=19, Criteria1:="G"
If Evaluate("=SUBTOTAL(3,A1:A65536)") > 1 Then
satır = s2.[A65536].End(3).Row + 1
    s1.Range("D4:D" & s1.Cells(Rows.Count, "A").End(3).Row).SpecialCells(xlCellTypeVisible).Copy s2.Cells(satır, 1)
    s1.Range("B4:B" & s1.Cells(Rows.Count, "A").End(3).Row).SpecialCells(xlCellTypeVisible).Copy s2.Cells(satır, 2)
    s1.Range("E4:E" & s1.Cells(Rows.Count, "A").End(3).Row).SpecialCells(xlCellTypeVisible).Copy s2.Cells(satır, 3)
    s1.Range("S4:S" & s1.Cells(Rows.Count, "A").End(3).Row).SpecialCells(xlCellTypeVisible) = "[COLOR="Red"]AKTARILDI[/COLOR]"
End If
    s1.Range("A3:U65536").AutoFilter Field:=19
[B]End Sub[/B][/FONT]

 

[asdek]

Teşekkür ederim Ömer Bey,
Çok güzel oldu.

Fakat benim kullanmakta olduğum sayfa daha kapsamlı olduğu için kodları değiştirerek ona uyarlamayı deniyorum ama hata koduyla karşılaşıyorum.

 

[Ömer BARAN]

Tekrar merhaba.

İşte tam da bu nedenle sorulara eklenen örnek belgelerin
gerçek belgeyle aynı yapıda olmasını istiyoruz.
(cevaplarımın altındaki İMZA bölümüne bakınız)
.

 

[asdek]

Tekrar merhaba.

İşte tam da bu nedenle sorulara eklenen örnek belgelerin
gerçek belgeyle aynı yapıda olmasını istiyoruz.
(cevaplarımın altındaki İMZA bölümüne bakınız)
.

Peki, özür dilerim. Dosya ektedir.

 

[Ömer BARAN]

Estağfurullah, sorun değil ama,
bir mesajda bitecek konu gereksiz uzamasın diye o şekilde rica ediyoruz.

Önceki cevabımdaki kod'u güncelledim.
.

 

[asdek]

Estağfurullah, sorun değil ama,
bir mesajda bitecek konu gereksiz uzamasın diye o şekilde rica ediyoruz.

Önceki cevabımdaki kod'u güncelledim.
.

Çok teşekkür ederim. Fakat oradaki koşulu hücrelerdeki renkleride kopyalıyor YAZDIR sayfasındaki biçimi korusak daha iyi olur.

 

[Ömer BARAN]

Kod'da yer alan End Sub satırından önce aşağıdaki satırı ekleyin.
.

[FONT="Arial Narrow"]    s2.Cells.FormatConditions.Delete[/FONT]

 

[asdek]

Kod'da yer alan End Sub satırından önce aşağıdaki satırı ekleyin.
.

[FONT="Arial Narrow"]    s2.Cells.FormatConditions.Delete[/FONT]

Çok teşekkür ederim, Allah razı olsun. Ellerinize sağlık hocam.