verileri ayrı sayfalarda guruplama

[h.aykol_]

arkadaşlar benim çözemediğim sorun şu;

(çıkışlar) diye bir excel sayfam var.
birde
(çıkış ayrıntıları)diye excel sayfam var.

(çıkışlar) sayfasına girdeğim her veri (çıkış ayrıntıları) diye sayfamda kendi sayfasına veri olarak aktarılsın.istiyorum.ama bir türlü beceremedim.uzman arkadaşlarımızyardımcı olursa çok mutlu olurum.şimdiden ÇOK TEŞEKKÜR.

 

[N.Ziya Hiçdurmaz]

Kitapların ikiside açık olmalı.
Sub aktar()
On Error Resume Next
For i = 1 To Workbooks("çıkış ayrıntıları.xls").Sheets.Count
For Each bak In Range("b2:b50")
If bak = Workbooks("çıkış ayrıntıları.xls").Sheets(i).Name Then
bak.EntireRow.Copy
say = WorksheetFunction.CountA(Workbooks("çıkış ayrıntıları.xls").Sheets(i).[a1:a65000])
Workbooks("çıkış ayrıntıları.xls").Sheets(i).Range("a" & say + 1).PasteSpecial
End If
Next
Next
Application.CutCopyMode = False
End Sub

 

[N.Ziya Hiçdurmaz]

yanıt

Dosyanız ektedir.

 

[h.aykol_]

V.Basic For Applications ilgine teşekkür ederim.inceledim ama yeni veri girip de aktar dediğim zaman önceki girilmiş verileri tekrar giriyor.ya o verileri silip güncel verileri girmeli,yada sadece yeni giriş yaptığın veriyi aktar malı.bunu çözerseniz çok işime yarayacak,birde hesaplamaları (c) ile (e) hücrelerini makro ile çapma yaparsa çok iyi olur.İLGİNE TEŞEKKÜR

 

[Orion1]

Merhaba.
Ekli dosyayı inceleyiniz.Kaydet tuşuna bastığınızda kaydediyor.Yalnız her 2 dosyanında açık olması gerekiyor.Verileri 2nci satıra giriyorsunuz.
Kodlarda aşağıdadır.

Sub kaydet()
Dim i As Byte, sonsat As Long
Dim cikis_ayrintilari_sonsat As Long, sayfa As String
If Range("A2").Value = "" Then
    MsgBox "Bir Sıra No vermeden kayıt yapamazsınız.!", vbCritical
Exit Sub
End If
cikislar_sonsat = ThisWorkbook.Sheets("çıkışlar").Cells(65536, "A").End(xlUp).Row
If cikislar_sonsat = 65535 Then
    MsgBox "Sayfa Doldu.Başka Kayıt Yapamazsınız.!!", vbCritical
    Exit Sub
End If
sayfa = ThisWorkbook.Sheets("çıkışlar").Range("B2").Value
cikis_ayrintilari_sonsat = Workbooks("çıkış ayrıntıları.xls").Sheets(Range("B2").Value).Cells(65536, "A").End(xlUp).Row
If cikis_ayrintilari_sonsat = 65535 Then
    MsgBox "ÇIKIŞ AYRINTILARI sayfasındaki " & Range("B2").Value & " Sayfası doldu.Başka kayıt yapamazsınız..!!", vbCritical
    Exit Sub
End If
Workbooks("çıkış ayrıntıları.xls").Sheets(sayfa).Cells(cikis_ayrintilari_sonsat + 1, "A").Value = Workbooks("çıkış ayrıntıları.xls").Sheets(sayfa).Range("A1").Value + 1
Workbooks("çıkış ayrıntıları.xls").Sheets(sayfa).Cells(cikis_ayrintilari_sonsat + 1, "A").Value = Workbooks("çıkış ayrıntıları.xls").Sheets(sayfa).Range("A1").Value + 1
For i = 1 To 7
    ThisWorkbook.Sheets("çıkışlar").Cells(cikislar_sonsat + 1, i).Value = ThisWorkbook.Sheets("çıkışlar").Cells(2, i).Value
    Workbooks("çıkış ayrıntıları.xls").Sheets(sayfa).Cells(cikis_ayrintilari_sonsat + 1, i + 1).Value = ThisWorkbook.Sheets("çıkışlar").Cells(2, i).Value
    If i <> 6 Then
        ThisWorkbook.Sheets("çıkışlar").Cells(2, i).Value = ""
    End If
Next
MsgBox "K A Y I T   Y A P I L D I ...!!!", vbOKOnly
End Sub

 

[h.aykol_]

sayın SEZER ilgine teşekkür ederim ama hata iletisi veriyor.klasör ekte

 

[Orion1]

sayın SEZER ilgine teşekkür ederim ama hata iletisi veriyor.klasör ekte

ilk yolladığınız dosya ile şimdiki dosya farklı.
ilk yoladığınız dosya adı çıkış ayrıntıları.xls idi şimdi yolladığınız dosya adı ise
çıkış_ayrıntıları.xls.
benim yolladığım dosyada hata yok düzgün çalışıyor.
Siz dosyanın adını değiştirmişsiniz.
çıkış_ayrıntıları.xls dosyasının adını çıkış ayrıntıları.xls olarak değeiştiri.Dosya çalışacaktır.
Birde çıkış ayrıntıları dosyasındaki sayfaların A1 hücresine O andaki en son kayıtlı verinin sıra nosunu yazmaya unutmayın.

 

[h.aykol_]

sayın SEZER kusura bakma ama ben biraz önce size mesaj olarak geçtiğim klasörde dosya adını şundan değiştirdim.
siz kod düzenleme sayfasında (çıkış_ayrıntılar&#305 diye yazmışsınız ondan dolayı dosya adını değiştirip denedim.ama gene olmadı gene olmadı.düzeltim olmadı.2.adet excel sayfası siz adlandırın oluşturun. ben beceremedim. özür dilerim.LÜTFEN !!!

 

[Orion1]

Merhaba.
çıkış ayrıntıları dosyasını ekte yolluyorum. Deneyiniz.

 

[ambarli]

Sayın moderatör ekli dosyalar indirilemiyor.Bu dosya benim işime yarayacak gibi görünüyor.Emeği geçenlere teşekkürler.İndirme sorununu giderebilirseniz sevinirim.