• DİKKAT

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

Ayrı iki sayfaya birden veri aktarma makrosu

M

mesutnet24

Katılım
22 Şubat 2008
Mesajlar
29
Excel Vers. ve Dili
office xp türkce
Değerli Excel hocalarım. Ekte gönderdiğim dosyamdaki makroda bir hata var. çok uğraşmama rağmen hatayı düzeltemedim. Forumdada veri aktarma hususunu arattım ama dökümanlarda bu soruna benzer sorun yok galiba. Ya da bulamadıysam özür dilerim.

Yardımcı olabilirsenız çok mutlu olurum.
Teşekkürler.
 

Ekli dosyalar

Merhaba
Dosya yok ama nasıl olacak_?
Ayrıca hem dosyada hem de konu içinde açıklama yapınız. Sizin gibi eski bir üyenin böyle bir hata yapmasına anlam veremedim açıkcası
 
İhsan bey dalgınlıkla dosyayı upload etmemişim . Özür dileyerek tekrar yükledim .Dosya ektedir.
 
mesutnet24' Alıntı:
İhsan bey dalgınlıkla dosyayı upload etmemişim . Özür dileyerek tekrar yükledim .Dosya ektedir.
Genişletmek için tıkla ...

Açıklamalarınızı lütfen gözden geçirin.
1. sorunuz aynı veriyi iki defa atması ve arasında boşlukla bunu anladım ama ikinci sorudaki Gelir gider yok Giriş Çıkış var. Ayrıca tam olarak nasıl olduğunu anlamadım. Ne yapması gerekiyor biraz daha açık anlatınız
 
Abicim çok detaylı anlattım makroda yardımcı olabilirseniz sevinirim.
Hayırlı cumalar.
 

Ekli dosyalar

mesutnet24' Alıntı:
Abicim çok detaylı anlattım makroda yardımcı olabilirseniz sevinirim.
Hayırlı cumalar.
Genişletmek için tıkla ...

Merhaba
Bu kodu dener misiniz_?
Kod: 
Option Explicit
Sub kayıt()
Dim trabzonspor
trabzonspor = MsgBox("Kaydı Yapıyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.ScreenUpdating = False
trabzonspor = Sheets("ÇIKTI").Range("B65536").End(xlUp).Row
If Sheets("KASA").Range("E8") <> "" And Sheets("KASA").Range("D8") <> "" Then
Sheets("ÇIKTI").Range("B" & trabzonspor + 1) = Sheets("KASA").Range("B8").Value
Sheets("ÇIKTI").Range("C" & trabzonspor + 1) = Sheets("KASA").Range("C8").Value
Sheets("ÇIKTI").Range("D" & trabzonspor + 1) = Sheets("KASA").Range("D8").Value
Sheets("ÇIKTI").Range("B" & trabzonspor + 2) = Sheets("KASA").Range("B8").Value
Sheets("ÇIKTI").Range("C" & trabzonspor + 2) = Sheets("KASA").Range("C8").Value
Sheets("ÇIKTI").Range("E" & trabzonspor + 2) = Sheets("KASA").Range("E8").Value
ElseIf Sheets("KASA").Range("E8") = "" And Sheets("KASA").Range("D8") <> "" Then
Sheets("ÇIKTI").Range("B" & trabzonspor + 1) = Sheets("KASA").Range("B8").Value
Sheets("ÇIKTI").Range("C" & trabzonspor + 1) = Sheets("KASA").Range("C8").Value
Sheets("ÇIKTI").Range("D" & trabzonspor + 1) = Sheets("KASA").Range("D8").Value
ElseIf Sheets("KASA").Range("E8") <> "" And Sheets("KASA").Range("D8") = "" Then
Sheets("ÇIKTI").Range("B" & trabzonspor + 1) = Sheets("KASA").Range("B8").Value
Sheets("ÇIKTI").Range("C" & trabzonspor + 1) = Sheets("KASA").Range("C8").Value
Sheets("ÇIKTI").Range("E" & trabzonspor + 1) = Sheets("KASA").Range("E8").Value
End If
Application.ScreenUpdating = True
MsgBox "Kaydı Yaptım", vbInformation, "Bitiş"
End Sub
Not : Uyarılarımızı dikkate almazsanız bundan sonra yardım etmem bilginiz olsun
 
İşyerinde sıkışık bir ortamda yardım istedim o sebeple biraz eksiklikler oldu kusura bakmayın.
Yardımlarınız için çok sağolun. Elinize sağlık.
Forum kurallarına uymaya çalışıyorum elimden geldiğince.
Yardım etmezsenizde canınız sağolsun.
 
İhsan bey makroyu denedim
sadece ÇIKTI sayfasına veri aktarıyor
her iki sayfaya aktarmıyor.
biraz uğraşırsam bakalım yapabilirim inşallah

Sizi fazla meşgul etmek istemiyorum.
 
mesutnet24' Alıntı:
İhsan bey makroyu denedim
sadece ÇIKTI sayfasına veri aktarıyor
her iki sayfaya aktarmıyor.
biraz uğraşırsam bakalım yapabilirim inşallah

Sizi fazla meşgul etmek istemiyorum.
Genişletmek için tıkla ...

Yapamadıysanız buyrun
Siz yoğunsunuz biz de zamanımızdan ve işimizi durdurarak size yardım etmeye çalışıyoruz bunları unutmayın.
Kod: 
Option Explicit
Sub kayıt()
Dim trabzonspor, ts
trabzonspor = MsgBox("Kaydı Yapıyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.ScreenUpdating = False
trabzonspor = Sheets("ÇIKTI").Range("B65536").End(xlUp).Row
ts = Sheets("KASADETAY").Range("B65536").End(xlUp).Row
If Sheets("KASA").Range("E8") <> "" And Sheets("KASA").Range("D8") <> "" Then
Sheets("ÇIKTI").Range("B" & trabzonspor + 1) = Sheets("KASA").Range("B8").Value
Sheets("ÇIKTI").Range("C" & trabzonspor + 1) = Sheets("KASA").Range("C8").Value
Sheets("ÇIKTI").Range("D" & trabzonspor + 1) = Sheets("KASA").Range("D8").Value
Sheets("ÇIKTI").Range("B" & trabzonspor + 2) = Sheets("KASA").Range("B8").Value
Sheets("ÇIKTI").Range("C" & trabzonspor + 2) = Sheets("KASA").Range("C8").Value
Sheets("ÇIKTI").Range("E" & trabzonspor + 2) = Sheets("KASA").Range("E8").Value
Sheets("KASADETAY").Range("B" & ts + 1) = Sheets("KASA").Range("B8").Value
Sheets("KASADETAY").Range("C" & ts + 1) = Sheets("KASA").Range("C8").Value
Sheets("KASADETAY").Range("D" & ts + 1) = Sheets("KASA").Range("D8").Value
Sheets("KASADETAY").Range("B" & ts + 2) = Sheets("KASA").Range("B8").Value
Sheets("KASADETAY").Range("C" & ts + 2) = Sheets("KASA").Range("C8").Value
Sheets("KASADETAY").Range("E" & ts + 2) = Sheets("KASA").Range("E8").Value
ElseIf Sheets("KASA").Range("E8") = "" And Sheets("KASA").Range("D8") <> "" Then
Sheets("ÇIKTI").Range("B" & trabzonspor + 1) = Sheets("KASA").Range("B8").Value
Sheets("ÇIKTI").Range("C" & trabzonspor + 1) = Sheets("KASA").Range("C8").Value
Sheets("ÇIKTI").Range("D" & trabzonspor + 1) = Sheets("KASA").Range("D8").Value
Sheets("KASADETAY").Range("B" & ts + 1) = Sheets("KASA").Range("B8").Value
Sheets("KASADETAY").Range("C" & ts + 1) = Sheets("KASA").Range("C8").Value
Sheets("KASADETAY").Range("D" & ts + 1) = Sheets("KASA").Range("D8").Value
ElseIf Sheets("KASA").Range("E8") <> "" And Sheets("KASA").Range("D8") = "" Then
Sheets("ÇIKTI").Range("B" & trabzonspor + 1) = Sheets("KASA").Range("B8").Value
Sheets("ÇIKTI").Range("C" & trabzonspor + 1) = Sheets("KASA").Range("C8").Value
Sheets("ÇIKTI").Range("E" & trabzonspor + 1) = Sheets("KASA").Range("E8").Value
Sheets("KASADETAY").Range("B" & ts + 1) = Sheets("KASA").Range("B8").Value
Sheets("KASADETAY").Range("C" & ts + 1) = Sheets("KASA").Range("C8").Value
Sheets("KASADETAY").Range("E" & ts + 1) = Sheets("KASA").Range("E8").Value
End If
Application.ScreenUpdating = True
MsgBox "Kaydı Yaptım", vbInformation, "Bitiş"
End Sub
 
Size çoook ama çook teşekkür ederim.
Emeğiniz ve hakkınız geçti. Lütfen helal edin.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst