sayfadaki verileri başka kitaba aktarma

[orange4609]

Merhabalar,

kitap1/sayfa1 deki bütün hücrelerin içeriğini,başka bir kitap2/sayfa2 ye özel yapıştır olarak nasıl aktarabilirim.
ilginiz için işmdiden çok tşkler.

 

[İhsan Tank]

Merhabalar,

kitap1/sayfa1 deki bütün hücrelerin içeriğini,başka bir kitap2/sayfa2 ye özel yapıştır olarak nasıl aktarabilirim.
ilginiz için işmdiden çok tşkler.

Merhaba
Ne şekilde yapacağınızı anlamadım Örnek dosya eklerseniz yardımcı olmaya çalışırım.

 

[MEROGLU72]

Merhaba,

benimde sorunum aynı,

giriş sayfasına 8 acenteye ait verileri giriyorum. 102 kolona veri girişi var.

Buradan her acente için açılan sayfalara aktarmak istiyorum.

Formül kurdum ama çok yavaş çalışıyor üstelik daha 1 sayfa oluşturdum. 8 sayfaya uygularsam galiba formül çakılacak.

Yardım ederseniz sevinirim.

Tşkler.

 

[İhsan Tank]

Merhaba,

benimde sorunum aynı,

giriş sayfasına 8 acenteye ait verileri giriyorum. 102 kolona veri girişi var.

Buradan her acente için açılan sayfalara aktarmak istiyorum.

Formül kurdum ama çok yavaş çalışıyor üstelik daha 1 sayfa oluşturdum. 8 sayfaya uygularsam galiba formül çakılacak.

Yardım ederseniz sevinirim.

Tşkler.

Ne dememi bekliyorsunuz çok merak ediyorum açıkcası

 

[MEROGLU72]

Haklısınız bir örnek dosya gerek değil mi?

Dosya ektedir.

Tşkler

 

[İhsan Tank]

Haklısınız bir örnek dosya gerek değil mi?

Dosya ektedir.

Tşkler

Merhaba
Bu kodu kitabınızın kod bölümünde bulunan Thisworkbook'a kopyalayın ve sayfalar arasında gezin değişiklikleri gözlenleyin. ( Tabi Onayladıktan sonra )

Option Explicit
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If ActiveSheet.Name <> "TÜM GEMİLER" Then
Dim ts, kaplan, trabzonspor, hamsi As Date
Dim bordo
trabzonspor = MsgBox(ActiveSheet.Name & " Verilerini Aktarıyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.ScreenUpdating = False
hamsi = Time
Set bordo = Sheets("TÜM GEMİLER")
Range("A5:" & Cells(Rows.Count, Columns.Count).Address).ClearContents
kaplan = 5
Set ts = bordo.Range("A:A").Find(ActiveSheet.Name, , , xlWhole)
If Not ts Is Nothing Then
trabzonspor = ts.Address
Do
bordo.Rows(ts.Row).Copy _
Destination:=Range("A" & kaplan)
kaplan = kaplan + 1
Set ts = bordo.Range("A:A").FindNext(ts)
Loop While Not ts Is Nothing And ts.Address <> trabzonspor
End If
Application.ScreenUpdating = True
MsgBox Format(hamsi - Time, "hh:mm:ss") & " Sürede" & vbLf _
& ActiveSheet.Name & " Bilgilerini Aktardım", , "Bitiş"
End If
End Sub

 

[orange4609]

bilmiyorum neden yapıyor ama ben dosya ekleyemiyorum bu bilgisayardan.ancak ;benim istediğim bi sayfadaki verileri yaklaşık (15 sutun,20000 satır)tümünü bi başka sayfaya özel yapıştır olarak kopyalamasını istiyorum .

 

[İhsan Tank]

bilmiyorum neden yapıyor ama ben dosya ekleyemiyorum bu bilgisayardan.ancak ;benim istediğim bi sayfadaki verileri yaklaşık (15 sutun,20000 satır)tümünü bi başka sayfaya özel yapıştır olarak kopyalamasını istiyorum .

Merhaba
Rar , Zip kullanın Gene olmaz ise bir upload sitesinden yükleyin bakalım.

Yalnız siz iki dosya eklemeniz gerekiyor biri kopya yapılacak dosya biri yapıştırılacak dosya

 

[MEROGLU72]

merhaba
bu kodu kitabınızın kod bölümünde bulunan thisworkbook'a kopyalayın ve sayfalar arasında gezin değişiklikleri gözlenleyin. ( tabi onayladıktan sonra )

option explicit
private sub workbook_sheetactivate(byval sh as object)
ıf activesheet.name <> "tüm gemiler" then
dim ts, kaplan, trabzonspor, hamsi as date
dim bordo
trabzonspor = msgbox(activesheet.name & " verilerini aktarıyorum", vbyesno, "onay")
ıf trabzonspor = vbno then exit sub
application.screenupdating = false
hamsi = time
set bordo = sheets("tüm gemiler")
range("a5:" & cells(rows.count, columns.count).address).clearcontents
kaplan = 5
set ts = bordo.range("a:a").find(activesheet.name, , , xlwhole)
ıf not ts ıs nothing then
trabzonspor = ts.address
do
bordo.rows(ts.row).copy _
destination:=range("a" & kaplan)
kaplan = kaplan + 1
set ts = bordo.range("a:a").findnext(ts)
loop while not ts ıs nothing and ts.address <> trabzonspor
end ıf
application.screenupdating = true
msgbox format(hamsi - time, "hh:mm:ss") & " sürede" & vblf _
& activesheet.name & " bilgilerini aktardım", , "bitiş"
end ıf
end sub

yardımınıza ve ilginize sonsuz tşkler.

Denedim. Barkon sayfasına aktarıyor ama cma cgm sayfasına aktarmadı.

Yeni sayfalar açarsam başka firmalara adına bunları ekler mi?

Tekrar tşkler.

 

[MEROGLU72]

Tmm kontrol ettim. harika çalışıyor.

Allah (C.C) size dert keder göstermesin.

iyi ki varsınız.

size tekrar sonsuz teşekkürlerimi sunuyorum.

Murat.

 

[İhsan Tank]

Tmm kontrol ettim. harika çalışıyor.

Allah (C.C) size dert keder göstermesin.

iyi ki varsınız.

size tekrar sonsuz teşekkürlerimi sunuyorum.

Murat.

Rica ederim
:keyif: