sayfa 1 deki verileri Sayfa2 ye almak

abbasonline · 22 Haziran 2011

sayfa 1 deki verileri Sayfa2 ye b sütunundaki veriye göre bulunduğu satırın tamamını almasını istiyorum.

haya-ji · 22 Haziran 2011

b sutununa deger yazdıkca sayfa 2 de cıkmasını mı istiyorsun. yani makro veri girişi yapılırken aynı zamanda bir yandan kopyalama mı yapsın.

İhsan Tank · 22 Haziran 2011

abbasonline' Alıntı:
sayfa 1 deki verileri Sayfa2 ye b sütunundaki veriye göre bulunduğu satırın tamamını almasını istiyorum.

merhaba
boş bir module

Kod:

Option Explicit
Sub veri_aktar()
Dim a As Long, asi As String
asi = MsgBox("Verileri Aktarayım Mı_?", vbYesNo, "Onay")
If asi = vbNo Then Exit Sub
Range("A2:A65536,C2:F65536").ClearContents
For a = 2 To Cells(65536, "B").End(xlUp).Row
If WorksheetFunction.CountIf(Sheets("Sayfa1").Range("B2:B65536"), Range("B" & a)) > 0 Then
Cells(a, "A") = WorksheetFunction.Index(Sheets("Sayfa1").Range("A2:F65536"), WorksheetFunction.Match( _
Range("B" & a).Value, Sheets("Sayfa1").Range("B2:B65536"), 0), 1)
Cells(a, "C") = WorksheetFunction.Index(Sheets("Sayfa1").Range("A2:F65536"), WorksheetFunction.Match( _
Range("B" & a).Value, Sheets("Sayfa1").Range("B2:B65536"), 0), 3)
Cells(a, "D") = WorksheetFunction.Index(Sheets("Sayfa1").Range("A2:F65536"), WorksheetFunction.Match( _
Range("B" & a).Value, Sheets("Sayfa1").Range("B2:B65536"), 0), 4)
Cells(a, "E") = WorksheetFunction.Index(Sheets("Sayfa1").Range("A2:F65536"), WorksheetFunction.Match( _
Range("B" & a).Value, Sheets("Sayfa1").Range("B2:B65536"), 0), 5)
Cells(a, "F") = WorksheetFunction.Index(Sheets("Sayfa1").Range("A2:F65536"), WorksheetFunction.Match( _
Range("B" & a).Value, Sheets("Sayfa1").Range("B2:B65536"), 0), 6)
End If
Next
MsgBox "Veriler Aktarıldı", vbInformation, "Bitiş"
End Sub

bu kodu kopyalayarak deneyeniz. sonra buton'a atıyabilirsiniz

abbasonline · 23 Haziran 2011

Teşekkürler, otomatik olması için nasıl bir ekleme yapmamız gerekli Sayfa2 de (B) sütununa numarayı yazıp Enter bastığımda ilgili satır Sayfa1 den kopmle gelsin ve Sayfa1 deki verilerde silinmesin.

İhsan Tank · 23 Haziran 2011

abbasonline' Alıntı:
Teşekkürler, otomatik olması için nasıl bir ekleme yapmamız gerekli Sayfa2 de (B) sütununa numarayı yazıp Enter bastığımda ilgili satır Sayfa1 den kopmle gelsin ve Sayfa1 deki verilerde silinmesin.

merhaba
Sayfa2'nin kod bölümüne

Kod:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B2:B65536")) Is Nothing Then Exit Sub
Call veri_aktar
End Sub

bu kodu kopyalayın. üstte verdiğim kodda modulede kalsın.
dilerseniz ikisini birleştirebilirsiniz

abbasonline · 28 Haziran 2011

İhsan bey,

Kusura bakmassanız 1. mesajdaki sorguyu (I) sütunundan yapmak istiyorum yani (B) sütunu yerine (I) sütunu, sizin makroda yerlerini ne kadar değiştirdim isede çalıştıramadım Sayfa2 (I) sütununa yazdığım rakamı LİSTE isimli sayfanın (I) sütununda arayacak ve (A) ile (K) sütunu dahil satırdaki tüm verileri Sayfa2 ye ilgili satıra yazdırmak istiyorum. Not

Excel kitabcığında 10 ile 12 adet sayfa mevcut)

Düzenlemeye çalıştığım sizin makrolar ekte ama beceremedim.

Option Explicit
Sub veri_aktar()
Dim a As Long, asi As String
asi = MsgBox("Verileri Aktarayım Mı_?", vbYesNo, "Onay")
If asi = vbNo Then Exit Sub
For a = 9 To Cells(65536, "I").End(xlUp).Row
If WorksheetFunction.CountIf(Sheets("LİSTE").Range("I2:I65536"), Range("I" & a)) > 0 Then
Cells(a, "A") = WorksheetFunction.Index(Sheets("LİSTE").Range("A2:K65536"), WorksheetFunction.Match( _
Range("I" & a).Value, Sheets("LİSTE").Range("I2:I65536"), 0), 1)
Cells(a, "B") = WorksheetFunction.Index(Sheets("LİSTE").Range("A2:K65536"), WorksheetFunction.Match( _
Range("I" & a).Value, Sheets("LİSTE").Range("I2:I65536"), 0), 2)
Cells(a, "C") = WorksheetFunction.Index(Sheets("LİSTE").Range("A2:K65536"), WorksheetFunction.Match( _
Range("I" & a).Value, Sheets("LİSTE").Range("I2:I65536"), 0), 3)
Cells(a, "D") = WorksheetFunction.Index(Sheets("LİSTE").Range("A2:K65536"), WorksheetFunction.Match( _
Range("I" & a).Value, Sheets("LİSTE").Range("I2:I65536"), 0), 4)
Cells(a, "E") = WorksheetFunction.Index(Sheets("LİSTE").Range("A2:K65536"), WorksheetFunction.Match( _
Range("I" & a).Value, Sheets("LİSTE").Range("I2:I65536"), 0), 5)
Cells(a, "F") = WorksheetFunction.Index(Sheets("LİSTE").Range("A2:K65536"), WorksheetFunction.Match( _
Range("I" & a).Value, Sheets("LİSTE").Range("I2:I65536"), 0), 6)
Cells(a, "G") = WorksheetFunction.Index(Sheets("LİSTE").Range("A2:K65536"), WorksheetFunction.Match( _
Range("I" & a).Value, Sheets("LİSTE").Range("I2:I65536"), 0), 7)
Cells(a, "H") = WorksheetFunction.Index(Sheets("LİSTE").Range("A2:K65536"), WorksheetFunction.Match( _
Range("I" & a).Value, Sheets("LİSTE").Range("I2:I65536"), 0), 8)
Cells(a, "J") = WorksheetFunction.Index(Sheets("LİSTE").Range("A2:K65536"), WorksheetFunction.Match( _
Range("I" & a).Value, Sheets("LİSTE").Range("I2:I65536"), 0), 10)
Cells(a, "K") = WorksheetFunction.Index(Sheets("LİSTE").Range("A2:K65536"), WorksheetFunction.Match( _
Range("I" & a).Value, Sheets("LİSTE").Range("I2:I65536"), 0), 11)

End If
Next
MsgBox "Veriler Aktarıldı", vbInformation, "Bitiş"
End Sub

İhsan Tank · 28 Haziran 2011

dosya eklermisiniz bu şekilde deneme yapamam

abbasonline · 28 Haziran 2011

İhsan bey, Kusura bakmayın dosya ekte;

abbasonline · 28 Haziran 2011

İhsan bey, internetin azizliğine uğradık onun için geç oldu,

İhsan Tank · 28 Haziran 2011

abbasonline' Alıntı:
İhsan bey, Kusura bakmayın dosya ekte;

merhaba
LİSTE sayfasının kod bölümüne

Kod:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("I2:I65536")) Is Nothing Then Exit Sub
Dim ts, kaplan
kaplan = MsgBox("Veri Karşılıklarını Aktarayım Mı_?", vbYesNo, "Onay")
If kaplan = vbNo Then Exit Sub
Range("A2:H65536,J2:K65536").ClearContents
For ts = 2 To Cells(65536, "I").End(xlUp).Row
If WorksheetFunction.CountIf(Sheets("VERİ").Range("I2:I65536"), _
Range("I" & ts).Value) > 0 Then
Cells(ts, "A") = WorksheetFunction.Index(Sheets("VERİ").Range("A2:K65536"), _
WorksheetFunction.Match(Range("I" & ts).Value, Sheets("VERİ").Range("I2:I65536"), 0), 1)
Cells(ts, "B") = WorksheetFunction.Index(Sheets("VERİ").Range("A2:K65536"), _
WorksheetFunction.Match(Range("I" & ts).Value, Sheets("VERİ").Range("I2:I65536"), 0), 2)
Cells(ts, "C") = WorksheetFunction.Index(Sheets("VERİ").Range("A2:K65536"), _
WorksheetFunction.Match(Range("I" & ts).Value, Sheets("VERİ").Range("I2:I65536"), 0), 3)
Cells(ts, "D") = WorksheetFunction.Index(Sheets("VERİ").Range("A2:K65536"), _
WorksheetFunction.Match(Range("I" & ts).Value, Sheets("VERİ").Range("I2:I65536"), 0), 4)
Cells(ts, "E") = WorksheetFunction.Index(Sheets("VERİ").Range("A2:K65536"), _
WorksheetFunction.Match(Range("I" & ts).Value, Sheets("VERİ").Range("I2:I65536"), 0), 5)
Cells(ts, "F") = WorksheetFunction.Index(Sheets("VERİ").Range("A2:K65536"), _
WorksheetFunction.Match(Range("I" & ts).Value, Sheets("VERİ").Range("I2:I65536"), 0), 6)
Cells(ts, "G") = WorksheetFunction.Index(Sheets("VERİ").Range("A2:K65536"), _
WorksheetFunction.Match(Range("I" & ts).Value, Sheets("VERİ").Range("I2:I65536"), 0), 7)
Cells(ts, "H") = WorksheetFunction.Index(Sheets("VERİ").Range("A2:K65536"), _
WorksheetFunction.Match(Range("I" & ts).Value, Sheets("VERİ").Range("I2:I65536"), 0), 8)
Cells(ts, "J") = WorksheetFunction.Index(Sheets("VERİ").Range("A2:K65536"), _
WorksheetFunction.Match(Range("I" & ts).Value, Sheets("VERİ").Range("I2:I65536"), 0), 10)
Cells(ts, "K") = WorksheetFunction.Index(Sheets("VERİ").Range("A2:K65536"), _
WorksheetFunction.Match(Range("I" & ts).Value, Sheets("VERİ").Range("I2:I65536"), 0), 11)
End If
Next
MsgBox "Karşılıkları Çıkarttım", vbInformation, "Bitiş"
End Sub

bu kodu ekleyerek I sütununa ekleme yaparak deneyiniz

abbasonline · 28 Haziran 2011

Range("A2:H65536,J2:K65536").ClearContents

BU SATIR SARI OLUYOR

abbasonline · 28 Haziran 2011

İhsan bey, düzelltim Liste sayfasına yazdığım rakamlar sayı olarak görmüyormuş, sizden ricam bunu bir düğme ekleyerek yapsam mümkünmü çünkü rakamları başka yerden kopyalayıp liste sayfasının (I) sütununa yapıştıracağım ve verileri aktar dediğimde düğmeye tıkladığımda veriler gelmiş olsun ve VERİ sayfasından da silmesin kopyasını alsın mümkünmü, kusura bakmayın

İhsan Tank · 28 Haziran 2011

bunu anlayamadım biraz daha açıklama ekler misiniz

abbasonline · 28 Haziran 2011

vermiş olduğunuz makroyu bir düğme vasıtası ile çalıştırmak için nasıl bir düzenleme yapmam gerekli.

TABLO · 28 Haziran 2011

Merhabalar bu siteyeye üye oldum ama bir türlü yararlanamıyrum

abbasonline · 28 Haziran 2011

İhsan bey, vermiş olduğunuz makroyu bir düğme vasıtası ile çalıştırmak için nasıl bir düzenleme yapmam gerekli.

İhsan Tank · 28 Haziran 2011

abbasonline' Alıntı:
İhsan bey, vermiş olduğunuz makroyu bir düğme vasıtası ile çalıştırmak için nasıl bir düzenleme yapmam gerekli.

lütfen biraz sabır

Kod:

Option Explicit
Sub karşılık()
Dim ts, kaplan
kaplan = MsgBox("Veri Karşılıklarını Aktarayım Mı_?", vbYesNo, "Onay")
If kaplan = vbNo Then Exit Sub
Range("A2:H65536,J2:K65536").ClearContents
For ts = 2 To Cells(65536, "I").End(xlUp).Row
If WorksheetFunction.CountIf(Sheets("VERİ").Range("I2:I65536"), _
Range("I" & ts).Value) > 0 Then
Cells(ts, "A") = WorksheetFunction.Index(Sheets("VERİ").Range("A2:K65536"), _
WorksheetFunction.Match(Range("I" & ts).Value, Sheets("VERİ").Range("I2:I65536"), 0), 1)
Cells(ts, "B") = WorksheetFunction.Index(Sheets("VERİ").Range("A2:K65536"), _
WorksheetFunction.Match(Range("I" & ts).Value, Sheets("VERİ").Range("I2:I65536"), 0), 2)
Cells(ts, "C") = WorksheetFunction.Index(Sheets("VERİ").Range("A2:K65536"), _
WorksheetFunction.Match(Range("I" & ts).Value, Sheets("VERİ").Range("I2:I65536"), 0), 3)
Cells(ts, "D") = WorksheetFunction.Index(Sheets("VERİ").Range("A2:K65536"), _
WorksheetFunction.Match(Range("I" & ts).Value, Sheets("VERİ").Range("I2:I65536"), 0), 4)
Cells(ts, "E") = WorksheetFunction.Index(Sheets("VERİ").Range("A2:K65536"), _
WorksheetFunction.Match(Range("I" & ts).Value, Sheets("VERİ").Range("I2:I65536"), 0), 5)
Cells(ts, "F") = WorksheetFunction.Index(Sheets("VERİ").Range("A2:K65536"), _
WorksheetFunction.Match(Range("I" & ts).Value, Sheets("VERİ").Range("I2:I65536"), 0), 6)
Cells(ts, "G") = WorksheetFunction.Index(Sheets("VERİ").Range("A2:K65536"), _
WorksheetFunction.Match(Range("I" & ts).Value, Sheets("VERİ").Range("I2:I65536"), 0), 7)
Cells(ts, "H") = WorksheetFunction.Index(Sheets("VERİ").Range("A2:K65536"), _
WorksheetFunction.Match(Range("I" & ts).Value, Sheets("VERİ").Range("I2:I65536"), 0), 8)
Cells(ts, "J") = WorksheetFunction.Index(Sheets("VERİ").Range("A2:K65536"), _
WorksheetFunction.Match(Range("I" & ts).Value, Sheets("VERİ").Range("I2:I65536"), 0), 10)
Cells(ts, "K") = WorksheetFunction.Index(Sheets("VERİ").Range("A2:K65536"), _
WorksheetFunction.Match(Range("I" & ts).Value, Sheets("VERİ").Range("I2:I65536"), 0), 11)
End If
Next
MsgBox "Karşılıkları Çıkarttım", vbInformation, "Bitiş"
End Sub

abbasonline · 28 Haziran 2011

Teşekkürler ellerinize sağlık, kolay gelsin.

İhsan Tank · 29 Haziran 2011

abbasonline' Alıntı:
Teşekkürler ellerinize sağlık, kolay gelsin.

rica ederim
:yazici:

derwishh · 30 Haziran 2011

merhaba hocam örnek dosyada belirtmeye çalıştım da sorunuma çözümde yardımcı olmanızı rica ediyorum.
Technik sayfasının AT sütununa AZ yazıldığı zaman o satırın A:AW arası komple AZ sayfasında 6. satrıdan başlayarak eklemesi lazım ama technik sayfasında ki asıl veriler silinmeyecek , ve sadece ilgili satırları sırasıyla AZ sayfasına yapıştıracak ,

Ayrıca AZ sayfasında AV Satırına erledigt yazıldığı zaman B sütünu yeşil olamalı ve aynı konu technik sayfasında da yeşil olmalı
bunu koşullu biçimlendirme ile denedim ama olmadı bu iki işlem için uygun bir kod varmıdır .
umarım anlatabilmişimdir.

Yardımlarınızı rica ediyorum.....

sayfa 1 deki verileri Sayfa2 ye almak

abbasonline

Ekli dosyalar

haya-ji

İhsan Tank

Misafir

abbasonline

İhsan Tank

Misafir

abbasonline

İhsan Tank

Misafir

abbasonline

Ekli dosyalar

abbasonline

İhsan Tank

Misafir

abbasonline

abbasonline

İhsan Tank

Misafir

abbasonline

TABLO

abbasonline

İhsan Tank

Misafir

abbasonline

İhsan Tank

Misafir

derwishh

Ekli dosyalar