• DİKKAT

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

şartlı aktarma

B

Barons

Altın Üye
Katılım
14 Mayıs 2005
Mesajlar
967
Excel Vers. ve Dili
Microsoft Ofis 365
merhaba
sayfa 1 deki bir kolonda olan sadece X işaretli verileri satırı ile birlikte 2 nolu sayfaya aktarmak istiyorum.
Dosyada açıklama mevcuttur.

Yardımlarınız için çok teşekkürler
 

Ekli dosyalar

Tamamda sayfa2 deki bilgiler silinip sıfırdanmı aktarılacak yoksa var olanların alınamı aktarılacak.:cool:
 
sayfa 2 deki değerleri örnek olması amacıyla koymuştum...sıfırdan aktarılacak.
 
Sn.Evren

Sayfa 2 deki bilgiler her seferinde silinebilir veya altaltada aktarılabilir...tekrar yardımlarınız için teşekkürler...
 
çözüm yok sanırım...Evren hoca ilgilendi bir ara ama..sanırım musait değil...
 
Sayın Barons,
Aşağıdaki kodlama sorununuzu çözecektir.

Kod: 
Sub Makro1()
son1 = [1!C65536].End(3).Row
son2 = [2!C65536].End(3).Row

Sheets("2").Select
Rows("2:" & son2).Select
Selection.Delete
Sheets("1").Select
Satir = 1
For i = 2 To son1
If Range("I" & i).Value = "X" Or Range("I" & i).Value = "x" Then
Satir = Satir + 1
Rows(i & ":" & i).Select
Selection.Copy
Sheets(2).Select
Range("A" & Satir).Select
ActiveSheet.Paste
Sheets("1").Select
End If
Next i

End Sub
 
makro bu işlemleri yaparken sayfanın hareket etmemesini isterseniz
makronun başına mesala son2 tanımının altına aşağıdaki kodu ekleyin.
Kod: 
Application.EnableEvents = False
makronun en altına da aşağıdaki kod ekleyin ki makro işini bitirdiğinde ekran hareket edebilsin

Kod: 
Application.EnableEvents = true
 
çok teşekkürler yardımınız için...
küçük bir sorun var....sayfa2 deki başlık kayboluyor...yani sayfa 2 tamamen sildik diyelim..makro çalıştığında X değerlerini atıyor ancak başlıksız atıyor...

tekrar teşekkürler
 
Sayın Barons
2. sayfadaki bilgileri manuel olarak siz silmiş olacaksınız ki bu tür bi hata ile karşılaşıyorsunuz
kodun düzenlenmiş hali ektedir.

Kod: 
Sub Makro1()
son1 = [1!C65536].End(3).Row
son2 = [2!C65536].End(3).Row

If Sheets("2").Range("B2").Value <> "" Then
Sheets("2").Select
Rows("2:" & son2).Select
Selection.Delete
End If
Sheets("1").Select
Satir = 1
For i = 2 To son1
If Range("I" & i).Value = "X" Or Range("I" & i).Value = "x" Then
Satir = Satir + 1
Rows(i & ":" & i).Select
Selection.Copy
Sheets(2).Select
Range("A" & Satir).Select
ActiveSheet.Paste
Sheets("1").Select
End If
Next i

End Sub
 
Aşağıdaki kodların altına kırmızı ile yazdığım kodları ilave ederseniz.Bir problem kalmaz.Başlıkların 1nci satırda olduğunu kabul ediyorum.
Kod: 
son1 = [1!C65536].End(3).Row
son2 = [2!C65536].End(3).Row
[B][COLOR="Red"]if son2= 1 then son2=2[/COLOR][/B]
 
Merhaba
İlk dosyada sadece I kolonu demişim ancak eksik olduğunu farkettim.Ayrıca V kolonundakilerdende X olanları ayırması gerekiyormuş.
Dosya ektedir.
Tekrar yardımcı olursanız çok sevinirim.
 

Ekli dosyalar

Arkadaşlar; Sorduğum soru bu başlığa uygun olduğu için burdan sormak istedim.

Arkadaşlar yapmak istediğim
Textbox'a yazılan tc kimlik numaralı kişinin bilgilerinin alt alta foto sayfasına aktarılması
*daha önce bilgileri aktarılmış ise uyarı verip aktarmamasını sağlamak.
veri sayfasında ise aktarılanları farklı bir renge boyamak yada bir şekilde işaretlemek.

form ve etiket sayfasına ise sadece son aktarılan kişilerin bilgilerinin bulunması
Örnek dosya ektedir.

İlgilenen arkadaşlara şimdiden teşekkürler.
 

Ekli dosyalar

Bu konuda yardımcı olacak arkadaş yokmu?
 
Güncellemek için
 
Teşekkürler İhsan Bey, Eline sağlık. Birde son aktarılan kaydı etiket ve form sayfasındaki yerlerine yazdırabilirsek tam olarak istediğime ulaşmış olacam.
 
Form ve etiket sayfasına son kaydı bir şekilde hallettim. Peki Texbox1 yerine herhangi bir hücreye yazsak aramak istediğimiz veriyi örn:G1'e yazsak kodları ne şekilde düzeltme yapılması lazım.?

Teşekkürler.
 
unur' Alıntı:
Form ve etiket sayfasına son kaydı bir şekilde hallettim. Peki Texbox1 yerine herhangi bir hücreye yazsak aramak istediğimiz veriyi örn:G1'e yazsak kodları ne şekilde düzeltme yapılması lazım.?

Teşekkürler.
Genişletmek için tıkla ...

merhaba
Kod: 
Private Sub AKTAR_Click()
If Range("G1").Text = Empty Then MsgBox "T.C. Kimlik Giriniz.", vbInformation: Exit Sub
Dim k As Range
Set k = Sheets("foto").Range("B:B").Find(Range("G1").Text, , xlValues, xlWhole)
If Not k Is Nothing Then
MsgBox "Böyle Bir kayıt Var", vbInformation
Exit Sub
End If
Cevap = MsgBox("KAYIT ETMEK İSTEDİĞİNİZDEN EMİNMİSİNİZ!", vbYesNo, "")
If Cevap = vbNo Then Exit Sub
Son_Dolu_Satir = Sheets("foto").Range("A65536").End(xlUp).Row
Bos_Satir = Son_Dolu_Satir + 1
Sheets("foto").Range("A" & Bos_Satir).Value = _
Application.WorksheetFunction.Max(Sheets("foto").Range("A:A")) + 1
Sheets("foto").Range("B" & Bos_Satir).Value = Range("G1").Text
MsgBox "Kayıt Yapıldı", vbInformation
End Sub
sayfadaki kod'u bununla değişirseniz istediğinize ulaşırsınız
 
İhsan Bey çok Teşekkürler; Elinize sağlık. Fazla excel bilgim olmadığı için veri girdikçe otomatik olarak formullerin nasıl yaydığınız konusundada bilgi verebilirmisiniz? Bunu kodlarla mı sağladınız yoksa farklı bir yoldan mı yaptınız?
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst