• DİKKAT

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

sayfalar arası geçiş

Katılım
15 Eylül 2011
Mesajlar
83
Excel Vers. ve Dili
office 2010
3391.jpg



arkadaşlar durumu yani J2 Sütunundaki durum mühürlü yazdığı zaman o satırı komple bu sayfadan alıp alt taraftaki sekmelerde bulunan mühürlü ve işi terk sayfasının içine atmasını istiyorum.... örenk dosya da var teşekkürler....
 

Ekli dosyalar

arkadaşlar durumu yani J2 Sütunundaki durum mühürlü yazdığı zaman o satırı komple bu sayfadan alıp alt taraftaki sekmelerde bulunan mühürlü ve işi terk sayfasının içine atmasını istiyorum.... örenk dosya da var teşekkürler....

Merhaba
Boş bir module kopyalayın ve deneyin
Kod:
Option Explicit
Sub aktar_61()
Dim ts, kaplan, trabzonspor, bordo
Sheets("MÜHÜRLÜ VE İŞİ TERK").Range("A2:Y65536").ClearContents
kaplan = 2
Set ts = Sheets("OTOPARKLAR LİSTESİ").Range("J:J"). _
Find("Mühürlü", , , xlWhole)
If Not ts Is Nothing Then
bordo = ts.Address
Do
Sheets("MÜHÜRLÜ VE İŞİ TERK").Cells(kaplan, "B") = _
Sheets("OTOPARKLAR LİSTESİ").Cells(ts.Row, "C")
Sheets("MÜHÜRLÜ VE İŞİ TERK").Cells(kaplan, "C") = _
Sheets("OTOPARKLAR LİSTESİ").Cells(ts.Row, "D")
Sheets("MÜHÜRLÜ VE İŞİ TERK").Cells(kaplan, "D") = _
Sheets("OTOPARKLAR LİSTESİ").Cells(ts.Row, "E")
Sheets("MÜHÜRLÜ VE İŞİ TERK").Cells(kaplan, "E") = _
Sheets("OTOPARKLAR LİSTESİ").Cells(ts.Row, "F")
Sheets("MÜHÜRLÜ VE İŞİ TERK").Cells(kaplan, "F") = _
Sheets("OTOPARKLAR LİSTESİ").Cells(ts.Row, "G")
Sheets("MÜHÜRLÜ VE İŞİ TERK").Cells(kaplan, "G") = _
Sheets("OTOPARKLAR LİSTESİ").Cells(ts.Row, "H")
Sheets("MÜHÜRLÜ VE İŞİ TERK").Cells(kaplan, "H") = _
Sheets("OTOPARKLAR LİSTESİ").Cells(ts.Row, "J")
Sheets("MÜHÜRLÜ VE İŞİ TERK").Cells(kaplan, "I") = _
Sheets("OTOPARKLAR LİSTESİ").Cells(ts.Row, "K")
Sheets("MÜHÜRLÜ VE İŞİ TERK").Cells(kaplan, "J") = _
Sheets("OTOPARKLAR LİSTESİ").Cells(ts.Row, "M")
Sheets("MÜHÜRLÜ VE İŞİ TERK").Cells(kaplan, "K") = _
Sheets("OTOPARKLAR LİSTESİ").Cells(ts.Row, "N")
Sheets("MÜHÜRLÜ VE İŞİ TERK").Cells(kaplan, "L") = _
Sheets("OTOPARKLAR LİSTESİ").Cells(ts.Row, "O")
Sheets("MÜHÜRLÜ VE İŞİ TERK").Cells(kaplan, "M") = _
Sheets("OTOPARKLAR LİSTESİ").Cells(ts.Row, "P")
Sheets("MÜHÜRLÜ VE İŞİ TERK").Cells(kaplan, "N") = _
Sheets("OTOPARKLAR LİSTESİ").Cells(ts.Row, "Q")
Sheets("MÜHÜRLÜ VE İŞİ TERK").Cells(kaplan, "O") = _
Sheets("OTOPARKLAR LİSTESİ").Cells(ts.Row, "S")
Sheets("MÜHÜRLÜ VE İŞİ TERK").Cells(kaplan, "P") = _
Sheets("OTOPARKLAR LİSTESİ").Cells(ts.Row, "X")
Sheets("MÜHÜRLÜ VE İŞİ TERK").Cells(kaplan, "Q") = _
Sheets("OTOPARKLAR LİSTESİ").Cells(ts.Row, "Y")
Sheets("MÜHÜRLÜ VE İŞİ TERK").Cells(kaplan, "R") = _
Sheets("OTOPARKLAR LİSTESİ").Cells(ts.Row, "Z")
Sheets("MÜHÜRLÜ VE İŞİ TERK").Cells(kaplan, "S") = _
Sheets("OTOPARKLAR LİSTESİ").Cells(ts.Row, "AA")
Sheets("MÜHÜRLÜ VE İŞİ TERK").Cells(kaplan, "T") = _
Sheets("OTOPARKLAR LİSTESİ").Cells(ts.Row, "AB")
Sheets("MÜHÜRLÜ VE İŞİ TERK").Cells(kaplan, "U") = _
Sheets("OTOPARKLAR LİSTESİ").Cells(ts.Row, "AC")
Sheets("MÜHÜRLÜ VE İŞİ TERK").Cells(kaplan, "V") = _
Sheets("OTOPARKLAR LİSTESİ").Cells(ts.Row, "AD")
Sheets("MÜHÜRLÜ VE İŞİ TERK").Cells(kaplan, "W") = _
Sheets("OTOPARKLAR LİSTESİ").Cells(ts.Row, "AE")
Sheets("MÜHÜRLÜ VE İŞİ TERK").Cells(kaplan, "X") = _
Sheets("OTOPARKLAR LİSTESİ").Cells(ts.Row, "AF")
Sheets("MÜHÜRLÜ VE İŞİ TERK").Cells(kaplan, "Y") = _
Sheets("OTOPARKLAR LİSTESİ").Cells(ts.Row, "AG")
kaplan = kaplan + 1
Set ts = Sheets("OTOPARKLAR LİSTESİ").Range("J:J").FindNext(ts)
Loop While Not ts Is Nothing And ts.Address <> bordo
End If
ts = Sheets("MÜHÜRLÜ VE İŞİ TERK").Range("B65536").End(xlUp).Row
Sheets("MÜHÜRLÜ VE İŞİ TERK").Range("A2") = 1
Sheets("MÜHÜRLÜ VE İŞİ TERK").Range("A2:A" & ts).DataSeries rowcol:=xlColumns, _
Type:=xlLinear, Date:=xlDay, step:=1, Trend:=True
End Sub
 
olmadı üstad ben bu modül işinden pek anlamıyorum teşekkürler genede yardımların için ama daha basit bir şekilde lazım bana modul ekle falan denedim ama yapamadım...
 
Geri
Üst