• DİKKAT

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

kelimeye göre satır kopyalama

Katılım
23 Haziran 2011
Mesajlar
5
Excel Vers. ve Dili
2003 pro
merhaba arkadaslar aranıza yeni katıldım bana bir sutundakı bir kelimenin aranıp o kelimenin kendı sayfaysına o satırı komple gönderecek kod lazım ve bu sonsoz dongü olması lazım ne zaman ekstra bir sey girildiğinde ana sayfaya onu ilgili sayfaya atacak acil yardımlarınızı beklıorum
 
mesela benim ana sayfamda 1000 satırlık bir satış listem ve orda bir malzemeden birden çok satılmıs o ana sayfaya her malzeme girdiğimde o satırı herseyıyle kendı sayfasına atmasını ıstıorum ama bır turlu yapamadım cvbnız ıcın sımdıden tskler
 
dosya yok mu onda açıklasanız bu şekilde olmaz ki_?
bir de başlığınızdaki acil kelimesi cevap almanıza engel olur bilginiz ben değiştiriyorum bu seferlik.
 
dosya yok mu onda açıklasanız bu şekilde olmaz ki_?
bir de başlığınızdaki acil kelimesi cevap almanıza engel olur bilginiz ben değiştiriyorum bu seferlik.
arkadaslar gecen dosya gonderememıstım sımdı gonderıorum ornek dosyadakı ısımlerın ana sayfaya her ekledığımde kendı sayfasına gıtmesını ıstıorum bır turlu yapazamadım kodu yardım edersenız sevınırım şimdiden herkese teşekkurler
 

Ekli dosyalar

arkadaslar gecen dosya gonderememıstım sımdı gonderıorum ornek dosyadakı ısımlerın ana sayfaya her ekledığımde kendı sayfasına gıtmesını ıstıorum bır turlu yapazamadım kodu yardım edersenız sevınırım şimdiden herkese teşekkurler

merhaba
kitabınızın kod bölümünde bulunan Thisworkbook bölümüne
Kod:
Option Explicit
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If ActiveSheet.Name <> "Sayfa1" Then
Dim c As Range, sat As Long, ilkadres As Variant, a As Long, asi As String
asi = MsgBox(ActiveSheet.Name & " Verilerini Aktarayım Mı_?", vbYesNo, "Onay")
If asi = vbNo Then Exit Sub
For a = 2 To Sheets("Sayfa1").Cells(65536, "A").End(xlUp).Row
Cells(a, "G") = Sheets("Sayfa1").Range("A" & a) & " " & Sheets("Sayfa1").Range("B" & a)
Next
Range("A2:F" & Rows.Count).ClearContents
sat = 2
With Range("G:G")
Set c = .Find(ActiveSheet.Name, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
ilkadres = c.Address
Do
Cells(sat, "A") = Sheets("Sayfa1").Cells(c.Row, "A")
Cells(sat, "B") = Sheets("Sayfa1").Cells(c.Row, "B")
Cells(sat, "C") = Sheets("Sayfa1").Cells(c.Row, "C")
Cells(sat, "D") = Sheets("Sayfa1").Cells(c.Row, "D")
Cells(sat, "E") = Sheets("Sayfa1").Cells(c.Row, "E")
Cells(sat, "F") = Sheets("Sayfa1").Cells(c.Row, "F")
sat = sat + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> ilkadres
End If
End With
Range("G:G").ClearContents
MsgBox ActiveSheet.Name & " Verilerini Aktardım", vbInformation, "Bitiş"
End If
End Sub
bu kodu kopyalayınız
 
saygılar

excel de yapılıyormu bilmem ama access te çok basıt yapabilirim sana göre bir dosya.
Eger excel de varsa öyle bir yol dosyanın son halini görmek isterim.
(huseyindeger.1982@hotmail.com) tşk.
 
arkadaslar cok tesekkur ederım cvpladıgınız ıcın ama benım demek ıstedıgım sonsuz dongude olacaktı ne eklersem ona sayfa acıp bılgılerını o acılan saydanın ıcıne gonderecek bır macro kod olacaktı hersey sonsuz bır sekılde olacak onu demek ıstemıstım...
 
Son düzenleme:
Geri
Üst