- Katılım
- 15 Eylül 2011
- Mesajlar
- 83
- Excel Vers. ve Dili
- office 2010
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
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....
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...
teşekkürler arkadaşlar ilginize uğraşıcağım biraz