• DİKKAT

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

Sayfalar arası veri aktarma

O

onurozbay

Katılım
16 Aralık 2011
Mesajlar
63
Excel Vers. ve Dili
2013 re
Merhaba;
Makro ile yapmak istediğim şey 1 numaralı saydaki defter numarası ve defter adının karşında bulunan okuma başlangıç, okuma bitiş, ödeme başlangıç ve ödeme bitiş tarihlerini 2 isimli sayfadaki
Defter numarası ve defter adının karşına yazacak. Ayrıca 1. Sayfada olup 2 .sayfada olmayan
Defter numara ve isimlerini 3. sayfaya kaydedecek.
Ayrıca belirtmeliyim ki iki safada birbirinden farkı sadece birkaç defter numarası ve defter ismi var karışık olduğundan yanıltmasın.

http://s3.dosya.tc/server8/eommmg/20...lani.xlsx.html
 
verdiginiz linki kontrol edin dosya bulunamadı diyor
 
bu sorunuz daha önce cevaplanmıştı. 1. sayfadaki nolar 2 den tamamen farklı, bu şekilde sıralayacak birşey yok.aynı şeyi tekrar istemişsiniz
 
verilerinizi inceledim. çok karışık.. 1 sayfada defter adı kısmındaki listeye baktım 2. sayfada defter adı kısmıda eşleşen bir değer göremedim..

bu kadar kabarık bir çalışma yerine örneklendirerek, tam olarak anlatmak istediğinizi sade bir dil ile anlatırsanız, çözümü daha basit olacaktır.. siz komple çalışmanızı atmışsınız çok karmaşık.. iyi çalışmalar..
 
1 nci sayfanın kod bölümüne ekleyin.Sayfa üzerinede CommandButton ekleyerek deneyin.
ilk okuma, son okuma, ödeme başlangıç, ödeme bitiş verilerini aktarıyor. Diğer verileride kırmızı ile belirtilmiş örneğe göre çoğaltabilirsiniz.

21.03.2016 Tarihinde güncellendi.
Kod: 
Private Sub CommandButton1_Click()
Dim i, k, deg
Set s1 = Sheets(1)
Set s3 = Sheets(3)
Application.ScreenUpdating = False
With Sheets(2)
.Range("A2:H" & Rows.Count).Interior.ColorIndex = xlNone
For i = 2 To .Range("c65536").End(3).Row
deg = .Cells(i, 3)
Set bul = s1.Range("C:C").Find(deg, , xlValues, xlWhole)
If bul > 0 Then
.Cells(i, "d") = s1.Cells(bul.Row, "d")
.Cells(i, "e") = s1.Cells(bul.Row, "e")
.Cells(i, "f") = s1.Cells(bul.Row, "f")
.Cells(i, "g") = s1.Cells(bul.Row, "g")
.Cells(i, "h") = s1.Cells(bul.Row, "h")
a = a + 1
End If
If deg = "" Then
b = b + 1
.Cells(i, "d") = WorksheetFunction.Sum(.Range("d" & i - a & ":d" & i - 1))
.Cells(i, "d").Font.Size = 12
.Cells(i, "d").Font.Bold = True
.Cells(i, "d").Interior.ColorIndex = 6
 a = 0
 End If
Next i
End With
Call yoksa
Application.ScreenUpdating = True
MsgBox "aktarma bitti"
End Sub
Sub yoksa()
Set s1 = Sheets(2)
Set s2 = Sheets(3)
s2.Range("A2:H" & Rows.Count).ClearContents
s2.Range("A2:H" & Rows.Count).Interior.ColorIndex = xlNone
With Sheets(1)
For i = 578 To .Range("c65536").End(3).Row
deg = .Cells(i, 3)
Set bul = s1.Range("C:C").Find(deg, , xlValues, xlWhole)
If bul Is Nothing Then
son = s2.Range("c65536").End(3).Row + 1
s2.Cells(son, "a") = .Cells(i, "a")
s2.Cells(son, "b") = .Cells(i, "b")
s2.Cells(son, "c") = .Cells(i, "c")
s2.Cells(son, "d") = .Cells(i, "d")
s2.Cells(son, "e") = .Cells(i, "e")
s2.Cells(son, "f") = .Cells(i, "f")
s2.Cells(son, "g") = .Cells(i, "g")
s2.Cells(son, "h") = .Cells(i, "h")
End If
Next
s2.Cells(son + 1, "d") = WorksheetFunction.Sum(s2.Range("d2" & ":d" & son + 1))
s2.Cells(son + 1, "d").Font.Size = 12
s2.Cells(son + 1, "d").Font.Bold = True
s2.Cells(son + 1, "d").Interior.ColorIndex = 6
End With
End Sub
 
Son düzenleme:
Güle güle kullanın.
 
:( Özür dilerim ayrıntılı bir şekilde kontrol ettiğimde verilerin tamamının doğru olarak aktarılmadığını gördüm ..
 
Olmayan dosyayı ekleyin bir görelim hata neymiş.
 
Baktım fakat iki sayfadaki sütun başlıkları uyuşmuyor. Mesela 2 sayfadaki abone sayısı 1. sayfanın hangi sütunundan alacak. Lütfen yardım alacaksanız dosyanızı düzgün bir şekilde ayarladıktan sonra ekleyin bizde bulmaca çözmeye çalışmayalım. Mesela 1 sayfa sütun başlıklarını 1,2,3 gibi yapıp 2 sayfada sütun başlıklarını ona göre(1.sayfa(1,2,3);2sayfa(2,3,1) gibi düzenleyin.
 
vardar07' Alıntı:
Baktım fakat iki sayfadaki sütun başlıkları uyuşmuyor. Mesela 2 sayfadaki abone sayısı 1. sayfanın hangi sütunundan alacak. Lütfen yardım alacaksanız dosyanızı düzgün bir şekilde ayarladıktan sonra ekleyin bizde bulmaca çözmeye çalışmayalım. Mesela 1 sayfa sütun başlıklarını 1,2,3 gibi yapıp 2 sayfada sütun başlıklarını ona göre(1.sayfa(1,2,3);2sayfa(2,3,1) gibi düzenleyin.
Genişletmek için tıkla ...

Umarım becerebilirim anlatmayı ilk başta sayfaları düzenledim .
Sayfa birdeki defter kodunun (b sutunu)karşısındaki okuma başlangıç,okuma bitiş,ödeme başlangıç,ödeme bitiş(e.f.g.h) sütunlarını 2 numaralı sayfanın aynı defter kodlu satırının karşındaki okuma başlangıç,okuma bitiş,ödeme başlangıç,ödeme bitiş(e.f.g.h)satırlarına yazacak 1.sutunda olup 2. Stunda olmayan defter kodunu 3numaralı sayfaya taşıyacak

http://www.dosya.tc/server7/aaelwh/1kesim.xlsx.html
 
#7 Nolu mesajdaki kodu değiştirip sonucu bildirirseniz memnun oluruz.
 
Kodu ekleyip farklı kaydet ile xls yada xlsm olarak kaydederek denedinizmi. Ayrıca ben 2007 32 bit office kullanıyorum siz galiba 2013 kullanıyorsunuz.


Örnek dosya
 

Ekli dosyalar

Son düzenleme:
Altın üye değilim maalesef indiremiyorum :(
bu arada evet kodu ekleyip farklı kaydet de yaptım
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst