• DİKKAT

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

Kritere göre bul yapıştır

  • Konbuyu başlatan Konbuyu başlatan gertt
  • Başlangıç tarihi Başlangıç tarihi
Katılım
1 Haziran 2009
Mesajlar
149
Excel Vers. ve Dili
2007
Türkçe
Belirli kritere göre farklı sütunlardaki verileri bulup yapıştıran bir makroya (Formül değil) ihtiyacım var.Örnek dosyayı ekledim.Teşekkürler.
 

Ekli dosyalar

Belirli kritere göre farklı sütunlardaki verileri bulup yapıştıran bir makroya (Formül değil) ihtiyacım var.Örnek dosyayı ekledim.Teşekkürler.

merhaba
bir butona atıyarak dener misiniz
Kod:
Sub İstediğin_Verileri_Listele()
Dim c As Range, sat As Long, ilkadres As Variant
Sheets("Sayfa2").Range("B4:O" & Rows.Count).ClearContents
sat = 4
With Sheets("Sayfa1").Range("B:B")
Set c = .Find(Sheets("Sayfa2").Range("A1"), LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
ilkadres = c.Address
Do
Sheets("Sayfa2").Cells(sat, "B") = Sheets("Sayfa1").Cells(c.Row, "B")
Sheets("Sayfa2").Cells(sat, "C") = Sheets("Sayfa1").Cells(c.Row, "C")
Sheets("Sayfa2").Cells(sat, "D") = Sheets("Sayfa1").Cells(c.Row, "D")
Sheets("Sayfa2").Cells(sat, "E") = Sheets("Sayfa1").Cells(c.Row, "E")
Sheets("Sayfa2").Cells(sat, "F") = Sheets("Sayfa1").Cells(c.Row, "F")
Sheets("Sayfa2").Cells(sat, "G") = Sheets("Sayfa1").Cells(c.Row, "G")
Sheets("Sayfa2").Cells(sat, "H") = Sheets("Sayfa1").Cells(c.Row, "H")
Sheets("Sayfa2").Cells(sat, "I") = Sheets("Sayfa1").Cells(c.Row, "I")
Sheets("Sayfa2").Cells(sat, "J") = Sheets("Sayfa1").Cells(c.Row, "J")
Sheets("Sayfa2").Cells(sat, "K") = Sheets("Sayfa1").Cells(c.Row, "K")
Sheets("Sayfa2").Cells(sat, "L") = Sheets("Sayfa1").Cells(c.Row, "L")
Sheets("Sayfa2").Cells(sat, "M") = Sheets("Sayfa1").Cells(c.Row, "M")
Sheets("Sayfa2").Cells(sat, "N") = Sheets("Sayfa1").Cells(c.Row, "N")
Sheets("Sayfa2").Cells(sat, "O") = Sheets("Sayfa1").Cells(c.Row, "O")
sat = sat + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> ilkadres
End If
End With
MsgBox "  [          " & Sheets("Sayfa2").Range("A1").Text & "          ]" & vbLf _
& " Verileri Listelendi", vbInformation
End Sub
 
İhsan bey, hayırlı geceler.Sayfa2'ye aktarılan veriler arasında boşluk olmadan (sayfa2'de veriler arasında boş sütünların olmaması) kodu yazabilir misiniz?İlginiz için teşekkürler.
 
İhsan bey,yazmış olduğunuz kodlar üzerinde düzenleme yaparak problemimi hallettim.Tekrar teşekkür eder,hayırlı geceler dilerim.
 
Geri
Üst