Sayfa1 a1'deki değeri aynı sayfada bul Sayfa2 ye aktar

[harziyan]

Sayfa1 a1 hücresinde yazdığım kimlik numarasını arayıp bulduktan sonra o satırı olduğu gibi sayfa2ye sıralı bir şekilde alt alta aktarmak istiyorum.
Bilgi için; sayfada taranacak satır sayısı gerçekte 3000 civarında.

 

[halit3]

dosya aşağıya çıkartılmıştır

 

[N.Ziya Hiçdurmaz]

Yanıt

Sub aktar()
Dim sa As Worksheet
Dim sat, son As Long
Set sa = Sheets("Aktar")
Set sv = Sheets("MazotGubre İcmal-1")
son = sa.Cells(65536, "a").End(xlUp).Row + 1
For sat = 4 To Cells(65536, "a").End(xlUp).Row
If sv.Cells(sat, "a") = sv.Range("a1").Value Then
Range(sv.Cells(sat, "a"), sv.Cells(sat, "n")).Copy Range(sa.Cells(son, "a"), sa.Cells(son, "n"))
End If: Next
End Sub

 

[harziyan]

k::
Her insanın hayatında küçük ama önemli olaylar vardır di mi. Benim için de bu olaylardan en mühim olanlardan birisidir http://www.excel.web.tr üyesi olmak. Mesajım için uğraş veren halit3 ve N.Ziya Hiçdurmaz'a teşekkürler.

 

[MORGAN]

Merhaba benimde benzer bir sorunum var macro dan anlamadığım için kendime uyarlayamadım yardımcı olmanızı rica ederim. Ekli dosyada üzerinde sürekli değişiklik yaptığım matematik sayfasının c sütunundaki beylikdüzü şubesi yazan satırları Beylikdüzü sayfasına almak istiyorum. Dosya örnek amaçlı küçüktür aslında öğrenim görülen tüm dersler ve 100 şube bulunmaktadır. En önemlisi ise makroyu nasıl çalıştırabilirim veya otomatik mi çalışır bilgi verirmisiniz. teşekkürler

 

[halit3]

dosya aşağıya konmuştur

 

[halit3]

dosya aşağıya çıkarıldı

 

[MORGAN]

Harika olmuş eline emeğine sağlık bunu geliştirmek için tekrar yardım alabilirim

 

[MORGAN]

umduğum hata karşıma çıktı ne yazık ki...

Halit Bey sizden bir isteğim daha olacak MATEMATİK sayfasında veri aktar diyorum örneğin AKSARAY ŞUBESİ dediğim zaman MATEMATİK sayfasındaki AKSARAY ŞUBESİ yazanları alıyor fakat BEYLİKDÜZÜ sayfasına ekliyor. Her şubeyi kendi sayfasına eklemek istiyorum kodlama kısmının mantığını anlatırmısınız? Bir de Aktar dediğimde son aktardığım verilerin sonuna değilde onların yerine aktarması mümkün mü

 

[MORGAN]

Sub Makro1()
sat = WorksheetFunction.CountA(Worksheets("BEYLİKDÜZÜ"). Range("A2:A65000")) + 2
sat1 = WorksheetFunction.CountA(Worksheets("BEYLİKDÜZÜ"). Range("A2:A65000")) + 1
deger = InputBox("aktarılacak veriyi giriniz.", _
"Veri aktarımı", "aktarılacak degeri giriniz")
For i = 2 To WorksheetFunction.CountA(Worksheets("TOPLU").R ange("c2:c65000")) + 2
If Worksheets("TOPLU").Cells(i, 3).Value = deger Then '"BEYLİKDÜZÜ ŞUBESİ" Then
For j = 1 To 16
Worksheets("BEYLİKDÜZÜ").Cells(sat, j).Value = Worksheets("TOPLU").Cells(i, j)
Next j
sat = sat + 1
End If
Next i
MsgBox "toplam " & sat - 1 - sat1 & " kişi aktarıldı aktarıldı"
End Sub
Sub Makro2()
sat = WorksheetFunction.CountA(Worksheets("AKSARAY"). Range("A2:A65000")) + 2
sat1 = WorksheetFunction.CountA(Worksheets("AKSARAY"). Range("A2:A65000")) + 1
deger = InputBox("aktarılacak veriyi giriniz.", _
"Veri aktarımı", "aktarılacak degeri giriniz")
For i = 2 To WorksheetFunction.CountA(Worksheets("TOPLU").R ange("c2:c65000")) + 2
If Worksheets("TOPLU").Cells(i, 3).Value = deger Then '"AKSARAY ŞUBESİ" Then
For j = 1 To 16
Worksheets("AKSARAY").Cells(sat, j).Value = Worksheets("TOPLU").Cells(i, j)
Next j
sat = sat + 1
End If
Next i
MsgBox "toplam " & sat - 1 - sat1 & " kişi aktarıldı aktarıldı"
End Sub


Halit Bey in paylaştığı makrolardan yola çıkarak iki adet makro tanımladım bu makroları 2 düğme oluşturup birbirine bağladım 100 tane şubem var 100 tane düğme oluşturup her düğmeye makro mu tanımlayacağım ya da tek düğme içerisinde bu yapılabilir mi yapılabilirse tek düğme ile ben örneğin; AKSARAY ŞUBESİ yazdığım zaman AKSARAY sayfasına atsın, BEYLİKDÜZÜ ŞUBESİ yazdığım zaman BEYLİKDÜZÜ sayfasına atsın ve tekrar AKSARAY ŞUBESİ yazdığımda AKSARAY sayfasındaki verilerin sonuna değilde A2 den sonrasını temizleyip bunların yerine yazsın ) biliyorum çok şey istiyorum ama bilgiyi bulduysan üstüne gitmek lazım

 

[halit3]

dosya aşağıda

 

[kayra75]

karşılaştırıp farkı yazmak

Halit bey sizden bende bu konuya benzer bir yardım rica ediyorum.
iki sheet mevcut elimde ve ikisinide karsılastırıp 3 cü bi2 sheet e farklı olan satırı komple atıcak birsey arıyorum.
sheet 1 deki satırı sheet 2 de bulup karsılastırıcak eger farklıysa bu satırı yazıcak birsey olması lazım.
Bu konuda sizden zahmet olmazsa yardımınızı rica ediyorum cünkü uzun bir süredir çözemedim.

 

[halit3]

sayın kayra75 hangi sutun sorgulanacak

 

[MORGAN]

ekli dosyaya bakınız

Sn.Halit3 ekli dosyaya baktım

AD = Worksheets(ActiveSheet.Name).Cells(a, 4).Value

yerine

AD = Worksheets(ActiveSheet.Name).Cells(a, 3).Value ,

yazınca herşey istediğim gibi oldu. Herşey için çok teşekkürler harikalar yarattınız...

 

[halit3]

kotda
AD = Worksheets(ActiveSheet.Name).Cells(a, 4).Value
yazan yeri
aşağıdakiyle değiştir

AD = Worksheets(ActiveSheet.Name).Cells(a, 3).Value

 

[MORGAN]

Merhaba yine ben bir isteğim daha olacak

yeni açılan sayfa da

veri sayfasının 1. Satırı var ve 3. Satırı var 2.satıra başka bir başlık ekliyorum onu almıyor

 

[halit3]

ekli dosyaya bakınız

 

[MORGAN]

ekli dosyaya bakınız

rica etsem benim ekli dosyama bakıp yeni açılan sayfalarda neden böyle yaptığını söyleyebilirmisiniz. formüllerle makro çakışıyor olabilir mi?

 

[halit3]

sayın morgon sizinki bölümü mü yoksa şübeyi mi baz alarak aktarılacak

 

[MORGAN]

Sayın halit03, ben bölümler oluşturacağım, bölümleri topluda formül ile çağırıp, topludan sizin makronuz sayesinde şubelere ayıracağım. Şubelere ayırdığımda oluşturduğum bölümler silinmeyecek, toplu sayfasında bir değişiklik olmayacak.
Değişkenlerim, bölüm sayfaları ve buna bağlı olarak toplu sayfam..