Sütundaki aynı olan verilerin şarta göre diğer sayfaya aktarılması..

[manly]

Ekte gönderdiğim dosya açıldığında FİRMA LİSTESİ butonuna tıklandığında 2011 Siparişler sayfasının D sütunundaki aynı ismi taşıyan firmaların, Z sütununda sadece yıldız olanlar şartı olmak üzere tüm satırları FİRMA sayfasının ilgili yerlerine bilgilerinin aktarılmasını istiyorum..

 

[İhsan Tank]

Ekte gönderdiğim dosya açıldığında FİRMA LİSTESİ butonuna tıklandığında 2011 Siparişler sayfasının D sütunundaki aynı ismi taşıyan firmaların, Z sütununda sadece yıldız olanlar şartı olmak üzere tüm satırları FİRMA sayfasının ilgili yerlerine bilgilerinin aktarılmasını istiyorum..

Merhaba
Boş bir module kopyalayın ve deneyin

Option Explicit
Sub firmalı_aktar_61()
Dim ts, kaplan, trabzonspor, bordo, mavi, süre As Date
Dim s1, s2
mavi = InputBox("Firma Giriniz", "Firma Girişi")
If mavi = "" Then Exit Sub
trabzonspor = MsgBox(mavi & " Firma Verilerini Çekiyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.ScreenUpdating = False
süre = Time
Set s1 = Sheets("2011 SİPARİŞLER")
Set s2 = Sheets("FİRMA")
s2.Range("A2:K65536").ClearContents
kaplan = 2
For ts = 2 To s1.Cells(65536, "B").End(xlUp).Row
If s1.Cells(ts, "D") = mavi And s1.Cells(ts, "Z") = "*" Then
s2.Cells(kaplan, "B") = s1.Cells(ts, "C")
s2.Cells(kaplan, "C") = s1.Cells(ts, "D")
s2.Cells(kaplan, "D") = s1.Cells(ts, "E")
s2.Cells(kaplan, "E") = s1.Cells(ts, "F")
s2.Cells(kaplan, "F") = s1.Cells(ts, "G")
s2.Cells(kaplan, "G") = s1.Cells(ts, "H")
s2.Cells(kaplan, "H") = s1.Cells(ts, "I")
s2.Cells(kaplan, "I") = s1.Cells(ts, "W")
s2.Cells(kaplan, "J") = s1.Cells(ts, "X")
s2.Cells(kaplan, "K") = s1.Cells(ts, "Z")
kaplan = kaplan + 1
End If
Next
ts = s2.Range("B65536").End(xlUp).Row
s2.Range("A2") = 1
Range("A2:A" & ts).DataSeries rowcol:=xlColumns, Type:=xlLinear, _
Date:=xlDay, step:=1, Trend:=True
Application.ScreenUpdating = True
MsgBox mavi & " Firmanın Verilerini " & Format(süre - Time, "hh:mm:ss") _
& " Sürede Çektim", vbInformation, "Bitiş"
End Sub

 

[manly]

Hocam denedim güzel siz tüm firmaların listesini aktarmışsınız. Ben firma seçimini kendim yapıp sadece o firmanın bilgilerinin aktarılmasını istiyorum..

 

[İhsan Tank]

Hocam denedim güzel siz tüm firmaların listesini aktarmışsınız. Ben firma seçimini kendim yapıp sadece o firmanın bilgilerinin aktarılmasını istiyorum..

Merhaba
Sayın manly hiç kendiniz caba sarfetmiyorsunuz aynı kodu size ve sitede defalarca verdim aynı sorularınızı devamlı soruyorsunuz.
Üstteki kodu güncelledim.

 

[manly]

Hocam öncelikle çok teşekkür ediyorum, hiç bir zaman geri çevirmediniz...Sizinle bayağı bir kod üzerine yazıştık... Hala da yazışacağımızı umuyorum. Çaba sarfetmeme konusunda haklısınız çaba sarfetmek inan çok istiyorum... Ama yeni işimde bazı şeyleri bir an önce rayına oturtmam gerekiyor. O yüzden direkt kodu sizden istiyorum.. Şu an kendime vakit dahi ayıramıyorum...Çalıştığım iş özel bir kurum..

 

[İhsan Tank]

Hocam öncelikle çok teşekkür ediyorum, hiç bir zaman geri çevirmediniz...Sizinle bayağı bir kod üzerine yazıştık... Hala da yazışacağımızı umuyorum. Çaba sarfetmeme konusunda haklısınız çaba sarfetmek inan çok istiyorum... Ama yeni işimde bazı şeyleri bir an önce rayına oturtmam gerekiyor. O yüzden direkt kodu sizden istiyorum.. Şu an kendime vakit dahi ayıramıyorum...Çalıştığım iş özel bir kurum..

Hayırlısı inşallah dediğinizi yaparsınız.
Rica ederim
:keyif:

 

[manly]

İnşallah hocam,
Öncelik vatan için, sonra kendimiz....