başka excel sayfasına veri kaydetme

asiiiruzgar · 17 Ağustos 2007

Arkadaşlar benim üzerinde çalıştığım 10 adet defter var bunlarında adı
902-903-904-905-910-931-930-920-901-900
bu defterlere işlemeyi tek bir yerden yapıp ilgili yerlere kendi kaydedermi acaba
açılamalı bir şekilde ekte gönderdim incelerseniz sevinirim.
olmayacak bir şeyse beni uyarırsanız sevinirim
boşuna ümitlenmeyim bari.

Recep İpek · 17 Ağustos 2007

asiiiruzgar' Alıntı:
boşuna ümitlenmeyim bari.

Bence ümitlenin derim.

Çünkü excelde yapılamayacak birşey yoktur.

Aşağıdaki kodları kullanabilirsiniz.

Tüm dosyalarınızın aynı klasörde ve maksimum 3 adet tablonuzun olduğu düşünülmüştür.

Kod:

Sub Kaydet01()
Dim durum As Boolean
Set s1 = Sheets("giriş")
son = 0
sira = 0
Application.ScreenUpdating = False
For i = 2 To [a65536].End(3).Row
baskanlik = s1.Cells(i, "a").Value
dosya = ThisWorkbook.Path & "/" & baskanlik & ".xls"
sayfakodu = s1.Cells(i, "b").Value
altkodu = s1.Cells(i, "e").Value
adisoyadi = s1.Cells(i, "f").Value
tahakkuk = s1.Cells(i, "h").Value
tarihi = s1.Cells(i, "I").Value
tutari = s1.Cells(i, "j").Value
durum = False
'************************************
Set xlBook = Workbooks.Open(dosya)
Set Sh = xlBook.Sheets(sayfakodu)
    No1 = WorksheetFunction.Count(Sh.Range("a22:a48"))
    No2 = WorksheetFunction.Count(Sh.Range("a55:a94"))
    No3 = WorksheetFunction.Count(Sh.Range("a101:a140"))
    toplam = No1 + No2 + No3
    If toplam >= 0 And toplam < 27 Then
    son = No1 + 1 + 21
    sira = No1 + 1
    ElseIf toplam >= 27 And toplam < 67 Then
    son = No2 + 1 + 21 + 6 + 27
    sira = No2 + 1
    ElseIf toplam >= 67 And toplam < 107 Then
    son = No3 + 1 + 21 + 6 + 27 + 6 + 40
    sira = No3 + 1
    Else
    MsgBox baskanlik & " Dosyasında Yeterli TABLO Tanımlı Değil."
    Exit Sub
    End If
    Sh.Cells(son, "a") = sira
    Sh.Cells(son, "b") = tarihi
    Sh.Cells(son, "e") = tahakkuk
    Sh.Cells(son, "g") = adisoyadi
    For Each bul In Sh.Range("V20:BY20")
    If bul = altkodu Then
    Col = bul.Column
    durum = True
    End If
    Next
    If durum = False Then
    MsgBox baskanlik & " dosyasında " & sayfakodu & " Sayfasında " & altkodu & " Alt Kodu Tanımlı Değil."
    Exit Sub
    End If
    Sh.Cells(son, Col) = tutari
    xlBook.Save
    xlBook.Close
Set xlBook = Nothing
Set xlApp = Nothing
'************************************
Next i
MsgBox "Tüm Bilgiler İlgili Tablolara Aktarıldı."
Application.ScreenUpdating = False
Set s1 = Nothing
'www.excel.web.tr/ripek
End Sub

asiiiruzgar · 20 Ağustos 2007

çok GÜzel

Sayın Ripek Çok Teşekkür Ederim. Yanlız
Tablo 3 Tane İle Sınırlı Kalmış ben Bunu 15 Yapmam İçin ne Yapmam Lazım
ve Deftere Giriş Kısmı Satır Sayısını Çoğaltırsam Hepsini Alırmı Keydet Butonuna Tıkladığım An..
Yani Alt Altta 100 Evrak Yazdığımda Hepsini İlgili Sayfalara Aktarır Değilmi.

Recep İpek · 20 Ağustos 2007

asiiiruzgar' Alıntı:
Deftere Giriş Kısmı Satır Sayısını Çoğaltırsam Hepsini Alırmı Keydet Butonuna Tıkladığım An..
Yani Alt Altta 100 Evrak Yazdığımda Hepsini İlgili Sayfalara Aktarır Değilmi.

Arada boşluk olmamak kaydıyla istediğiniz satıra kadarki kayıtları alır.

asiiiruzgar · 20 Ağustos 2007

ripek' Alıntı:
Arada boşluk olmamak kaydıyla istediğiniz satıra kadarki kayıtları alır.

Ben Ekte Gönderiyorum 10 Tablodanda Fazla Olabilir Siz Bi Kontrol Edersiniz Göndermiş Olduğum Kadar Tablo Olsun Yeter Bana Oda Herhalde 18 veya 20 Tablo
Birde Yazmış Olduğum Bilgileri Diğer Sayfaya Atıyorda Sıra No Kısmı 27 den sonra tekrar 1 diye Başlıyor Onu 27 den 28 Gelecek Şekilde yani Sıra No Hiç Baştan Başlamıyacak Bir Başladımmı Ardarda Gitmesi Lazım.
Çok Teşekkürler.
Sayfa 03-9 Daki Tablo Sayısını baz alırsan iyi olur diğerleri hep o tablo sayısına ulaşacak

Recep İpek · 20 Ağustos 2007

Bu iş için en pratik yol, tablolardaki sıra sumaralarının dolu olmasıdır.

Ancak bu şekilde son kayıt satırını rahatlıkla bulabiliriz.

Bu arada kaydedilecek dosyanın bulunamaması durumdaki uyarıyıda halletmiş olduk...
Kodlarıda aşağıdaki şekilde düzeltiniz.

Kod:

Sub Kaydet01()
Dim durum As Boolean
Set s1 = Sheets("giri&#351;")
Application.ScreenUpdating = False
For i = 2 To [a65536].End(3).Row
baskanlik = s1.Cells(i, "a").Value
dosya = ThisWorkbook.Path & "/" & baskanlik & ".xls"
sayfakodu = s1.Cells(i, "b").Value
altkodu = s1.Cells(i, "e").Value
adisoyadi = s1.Cells(i, "f").Value
tahakkuk = s1.Cells(i, "h").Value
tarihi = s1.Cells(i, "I").Value
tutari = s1.Cells(i, "j").Value
durum = False
'************************************
kontrol = Dir(dosya)
If kontrol <> Empty Then
Set xlBook = Workbooks.Open(dosya)
Set Sh = xlBook.Sheets(sayfakodu)
    '********************************
    For j = 22 To 876  [color=red] '876 say&#305;s&#305;n&#305; maksimum tablo say&#305;s&#305;n&#305;n son sat&#305;r&#305;na g&#246;re [/color]d&#252;zeltiniz.
        If IsNumeric(Sh.Cells(j, "a").Value) = True And Sh.Cells(j, "b").Value = "" Then
            son = Sh.Cells(j, "a").Row
            Exit For
        End If
    Next j
    Sh.Cells(son, "b") = tarihi
    Sh.Cells(son, "e") = tahakkuk
    Sh.Cells(son, "g") = adisoyadi
    For Each bul In Sh.Range("V20:BY20")
    If bul = altkodu Then
    Col = bul.Column
    durum = True
    End If
    Next
    If durum = False Then
    MsgBox baskanlik & " dosyas&#305;nda " & sayfakodu & " Sayfas&#305;nda " & altkodu & " Alt Kodu Tan&#305;ml&#305; De&#287;il."
    Exit Sub
    End If
    Sh.Cells(son, Col) = tutari
    xlBook.Save
    xlBook.Close
Set xlBook = Nothing
Set xlApp = Nothing
Else
MsgBox baskanlik & " dosyas&#305; bulunamad&#305;"
Set s1 = Nothing
Exit Sub
End If
'************************************
Next i
MsgBox "T&#252;m Bilgiler &#304;lgili Tablolara Aktar&#305;ld&#305;."
Application.ScreenUpdating = False
Set s1 = Nothing
'www.excel.web.tr/ripek
End Sub

asiiiruzgar · 21 Ağustos 2007

oLMADI

Sayın Ripek Göndermiş Olduğunuz Kodları uyguladım Daha Önce Çalışan Program Şuan Çalışmıyor sebebini Bir Türlü Bulamadım.
Benim Sorunum İlk Siz Bana Göndermiş Olduğunuz Kod Çok Güzel Çalışıyor
Sorun Olarak Şunlar Var Ben Size Defter Giriş İle Bir Tane 904 Dosyası Gönderecem Kontrol Ederseniz Sevinitim.
Sorunlar Şunlar
1- Sıra No Kısmında Yazan numaralar 1 den başlayıp toplolar değiştikçe çoğalmasını istiyorum. her tablo başında yeniden 1 diye başlamasını istemiyorum.
2- Sıra No Şu Şekilde Ben Defterde Formüllemiştim yanındaki belli başlı hücreler dolunca otomatik numara veriyor yani üsteki no kaçsa bir sonrakini veriyor o şekilde kalsa olmazmı defterde (sıra no olan kısmında herhangibir rakam vermesini istemesek tabloda sıra no kısmına bakarsananız anlarsanız. zaten. kendisi otomatik verecek
3-tablo sayıları en çok bu defterde yani 904 dosyasında oluyor tablo sayısını 3 değilde bu 904 de bulunan tablo sayısı kadar verebilirmiyiz yani 15 ile 20 tablo sayısı

Recep İpek · 21 Ağustos 2007

ripek' Alıntı:
Bu iş için en pratik yol, tablolardaki sıra numaralarının dolu olmasıdır.

Ancak bu şekilde son kayıt satırını rahatlıkla bulabiliriz.

Sn.asiiiruzgar

İlgili mesajımda belirttiğim gibi her tablodaki sıra numaralarının elle girilerek dolu şekilde olması gerekmektedir.

asiiiruzgar · 21 Ağustos 2007

hım anladım tamam
peki tablo sayısı 3 ile sınırlıydı 10 15 ile 20 ye çıkaramayızmı

Recep İpek · 21 Ağustos 2007

ripek' Alıntı:

Kod:

    '********************************
    For j = 22 To 876  [color=red] '876 sayısını maksimum tablo sayısının son satırına göre [/color]düzeltiniz.
        If IsNumeric(Sh.Cells(j, "a").Value) = True And Sh.Cells(j, "b").Value = "" Then

Bunun için hiçbir şey yapmanıza gerek yok.

Sadece yine mesajda belirtildiği gibi 876 sayısını son tablonun son satırına göre düzeltmeniz yeterlidir.

asiiiruzgar · 21 Ağustos 2007

Yapamadım

Sn. Ripek Ben beceremedim Size Ben Dosyayı Göndersem Nerde Hata Yapıyorum anlamadım eklediğim zamanda keydetmiyor.

Recep İpek · 21 Ağustos 2007

Ekli dosyalarda gerekli düzenleme ve açıklamalar yapılmıştır.

.....

asiiiruzgar · 22 Ağustos 2007

sn. ripek

Sizin Göndermiş Olduğunuz Dosyaları aldım ve yazmış olduğunuz açıklamayı uyguladım bütün tabloları 1 den en sona kadar numaralandırdım
fakat deftere giriş yerinde yazdığım bilgiler kaydet butonuna tıkladığım an gitmiyor uyarıda tüm biligler ilgili tablolara aktarıldı diyor ama bakıyorum aktarılmamış. sebebi ne.

Recep İpek · 22 Ağustos 2007

Dosyalarınızı tekrar ekleyebilirmisiniz?

asiiiruzgar · 22 Ağustos 2007

Sn Ripek

Ben Şu Şekilde Bir Düzelttme Yaptım Ama Tablo Üç De kalıyor gene
Bir Bakarsanız Sevinirim
Eğer Yasnlışşa Tamamiyle
Ben Size Sizin Göndermiş olduğunuz Makrolu Dosyayı Göndereyim.

asiiiruzgar · 22 Ağustos 2007

Sn. Ripek

Bu Şekilde Çok Güzel Çalışıyor Ben Düzeltmeyi yapınca
Sorun Olarak SAdece Sıra No Kısmı Kqldı Kendisi 27 den sonra 28-29-30 diye sırayla gidemezmi bir baksanız ona bir de ben tablo olarak 180 küsür kayır yaptım tablo 5 kadar geldi hepsi normal olarak çalışıyor
ama benim göremiyeceğim bir hata varsa beni uyarında sonra başıma büyük bir dert almayım ödenek konusunda

asiiiruzgar · 22 Ağustos 2007

dosya

ben xls olarak gönderiyorum siz kontrol edersiniz ben sıkıntılarımı bir önceki üzette bulannan mesajlara göre size iletmiştim
sıra numarasını otomatik istemiyorum yanlız sizin dediğiniz gibi sıranumarasını önceden kendim versem gene olmuyor sıra numarasını karşılığı boş bile olsa o sıra numarasından sonrakini kendi 1 den başlayarak yaıyor

Recep İpek · 22 Ağustos 2007

Kodları aşağıdaki şekilde değiştiriniz.

Sh.Cells(son, "a") = toplam + 1
Sh.Cells(son, "b") = tarihi
Sh.Cells(son, "e") = tahakkuk
Sh.Cells(son, "g") = adisoyadi

Peki siz neden bu kodları kullandığınızı yazmadınız? Bende son yazdığım kodlar üzerinden gidiyorum.
Sonuçta birkaç gündür boşuna çabalıyoruz.

asiiiruzgar · 22 Ağustos 2007

Sn. Ripek

Ben Bugun Öğle Paydosunda Yazdım Ama Becerebildiğime Sevindim Şimdi Sizin Göndermiş olduğunuz kodları ekleyecek bakalım olur inşallah

asiiiruzgar · 22 Ağustos 2007

sN. rİPEK

Çok teşekkür ederim tam istediğim gibi çalışıyor valla çok güzel
ellerinize ve aklınıza sağlık peki sizden son kez bir yardım daha talep edebilirmiyim buda tamamlanırsa hiç bir sorun kalmayacak allaha şükürler olsun
sorun şu bu defterlere bir de gelen ödenekler yazılıyor oda defterin üzerinde bulunan kısma oralarıda aynı bu şekilde ayrı bir veri girişi sayfasında ekleme yapabilirmiyiz.
örenek olarak ekte dosya gönderdim daha açıklamalı orda yazıyor
inanın beni çok sevindirdiniz. teşekkürler tekrardan

ba&#351;ka excel sayfas&#305;na veri kaydetme

başka excel sayfasına veri kaydetme