Yatay verileri altalta diğer sayfaya aktarma

[Emir Hüseyin Çoban]

Merhaba Arkadaşlar,

Yanyana ilerleyerek veri girişi yaptığım bir tablom var.
Girdiğim verileri A sütunundaki belge tiplerine göre diğer sayfalara alt alta aktarmak istiyorum.

Ör. A sütununda MP yazan kayıtları MP-ERP sayfasına aktarmalı. Renklerle aktarma yerlerini belirtmeye çalıştım.
Kırmızı C sütunu tarihler, MP-ERP sayfasında AA sütununa
Sarı D sütunu borçlu kodu ve G alacaklı kodu, MP-ERP sayfasında F sütununa alt alta gelmeli.
Kahverengi J sütunundaki tutarlarda, MP-ERP sayfasına I ve J sütunana aktarmalı.
Yeşil ve mavi sütunlardaki sistemde aynı şekilde.

Verigirişi sayfasında verileri yanyana giriyorum, aktarma işlemi ile verileri alt alta getirmeye çalışıyorum.
Elimle olması gerektiği şekilde MP-ERP sayfasına verileri yazdım.

Karmaşık ve zor bi işlem. Yardım ve fikirlerinizi bekliyorum.

 

[Ömer]

Merhaba,

Açıklamada örnek olarak yazmışsınız.

MP yazan kayıtları MP-ERP

Sayfa aramaları bu şekilde - simgesinden önce gelen veri şeklindemi olacak.

.

 

[Emir Hüseyin Çoban]

Merhaba,

Açıklamada örnek olarak yazmışsınız.

MP yazan kayıtları MP-ERP

Sayfa aramaları bu şekilde - simgesinden önce gelen veri şeklindemi olacak.

.

Evet simgeden önceki veriler belge tiplerini oluşturuyor.

Belge tipleri MP, MG, MC, MV 4 tane
her belge tipi için bir sayfa olacak, isimlerine -ERP ekledim, ama daha iyi olur dediğiniz bir sistem varsa değişiklik yapabilirsiniz.

 

[Ömer]

Kodları module kopyalarak çalıştırınız..

Sub SayfalarAktar()
Dim Sayfa As Variant, i As Long, son As Long, Sv As Worksheet, j As Integer
Set Sv = Sheets("VERİGİRİŞİ")
 
For j = 1 To Worksheets.Count
    If Sheets(j).Name <> "VERİGİRİŞİ" And Sheets(j).Name <> "HESAP PLANI" Then
        Sheets(j).Range("F2:G65536, I2:J65536, O2:O65536, AA2:AA65536"). _
        ClearContents
    End If
Next j
 
On Error Resume Next
For i = 4 To Sv.Cells(Rows.Count, "A").End(xlUp).Row
    Sayfa = Sv.Cells(i, "A") & "-ERP"
    With Sheets(Sayfa)
        son = .Cells(Rows.Count, "AA").End(xlUp).Row + 1
        .Cells(son, "AA") = Sv.Cells(i, "C")
        .Cells(son + 1, "AA") = Sv.Cells(i, "C")
        .Cells(son, "F") = Sv.Cells(i, "D")
        .Cells(son + 1, "F") = Sv.Cells(i, "G")
        .Cells(son, "G") = Sv.Cells(i, "E")
        .Cells(son + 1, "G") = Sv.Cells(i, "H")
        .Cells(son, "I") = Sv.Cells(i, "J")
        .Cells(son + 1, "J") = Sv.Cells(i, "J")
        .Cells(son, "O") = Sv.Cells(i, "I")
        .Cells(son + 1, "O") = Sv.Cells(i, "I")
    End With
Next i
 
End Sub

.

 

[Emir Hüseyin Çoban]

Ömer Hocam teşekkürler, sorunsuz olarak çalışıyor. Açıkcası konuyu açarken böyle bir işlemin yapılabileceğini düşünmüyordum.
Ama ilginiz ve yardımlarınız sayesinde tam istediğim gibi çalışıyor.:bravo:
Kodları inceleyerek bir kaç ekleme yaptım.

Şöyle bir işlem ilave etmemiz mümkün mü;

ERP sayfalarına veriyi aktardığımızda, veri olan satırlara
A sütununa sıra numarası yazdırmalı. 1 2 3 gibi.
B ve C sütunlarına * işareti
K sütununa TL
L sütununa 1 yazdırabilirmiyiz.

Aktarma ve diğer işlemleri Giriş sayfasında butonlarla yapmayı düşünüyordum ancak, aşağıdaki kodlar giriş sayfasındaki yazılarıda siliyor.

For j = 1 To Worksheets.Count
    If Sheets(j).Name <> "VERİGİRİŞİ" And Sheets(j).Name <> "HESAP PLANI" Then
        Sheets(j).Range("E2:E65536,F2:G65536, I2:J65536, O2:O65536, AA2:AA65536"). _
        ClearContents
    End If
Next j

 

[Ömer]

Bu şekilde deneyiniz..

Sub SayfalarAktar()
Dim Sayfa As Variant, i As Long, son As Long, Sv As Worksheet, j As Integer
Set Sv = Sheets("VERİGİRİŞİ")
For j = 1 To Worksheets.Count
    With Sheets(j)
        If .Name = "MG-ERP" Or .Name = "MP-ERP" Or .Name = "MC-ERP" Or .Name = "MV-ERP" Then
            .Range("A2:C65536,E2:E65536,F2:G65536, I2:L65536, O2:O65536, AA2:AA65536").ClearContents
        End If
    End With
Next j
On Error Resume Next
For i = 4 To Sv.Cells(Rows.Count, "A").End(xlUp).Row
    Sayfa = Sv.Cells(i, "A") & "-ERP"
    With Sheets(Sayfa)
        son = .Cells(Rows.Count, "AA").End(xlUp).Row + 1
        If Sv.Cells(i, "C") <> "" Then
            .Cells(son, "A") = son - 1
            .Cells(son + 1, "A") = son
            .Cells(son, "B") = "*"
            .Cells(son + 1, "B") = "*"
            .Cells(son, "C") = "*"
            .Cells(son + 1, "C") = "*"
            .Cells(son, "K") = "TL"
            .Cells(son + 1, "K") = "TL"
            .Cells(son, "L") = "1"
            .Cells(son + 1, "L") = "1"
            .Cells(son, "AA") = Sv.Cells(i, "C")
            .Cells(son + 1, "AA") = Sv.Cells(i, "C")
            .Cells(son, "E") = Sv.Cells(i, "K")
            .Cells(son + 1, "E") = Sv.Cells(i, "L")
            .Cells(son, "F") = Sv.Cells(i, "D")
            .Cells(son + 1, "F") = Sv.Cells(i, "G")
            .Cells(son, "G") = Sv.Cells(i, "E")
            .Cells(son + 1, "G") = Sv.Cells(i, "H")
            .Cells(son, "I") = Sv.Cells(i, "J")
            .Cells(son + 1, "J") = Sv.Cells(i, "J")
            .Cells(son, "O") = Sv.Cells(i, "I")
            .Cells(son + 1, "O") = Sv.Cells(i, "I")
        End If
    End With
Next i
 
End Sub

.

 

[Emir Hüseyin Çoban]

ERP sayfalarına veriyi aktardığımızda, veri olan satırlara
A sütununa sıra numarası yazdırmalı. 1 2 3 gibi.
B ve C sütunlarına * işareti
K sütununa TL
L sütununa 1 yazdırabilirmiyiz.

Ömer Hocam, çok teşekkürler bu işlemi sorunsuz çalıştırıyor.

Ancak Sayfalarda artık temizleme yapmıyor, aktarma işlemi yaptıkca alt satırlara tekrar aktarıyor verileri.

 

[Ömer]

#6 nolu mesajı güncelledim, tekrar denermisiniz..

.

 

[Emir Hüseyin Çoban]

Ömer Hocam, mükemmel olmuş. Sorunsuz çalışıyor. :bravo:
İlgi ve yardımlarınız için çok teşekkür ederim.
Soruma zaman ayırıp emek harcadınız, zahmetler verdim.
İyi günler dilerim. :mutlu:

 

[Ömer]

Rica ederim. Sizede iyi günler..

.

 

[Emir Hüseyin Çoban]

Merhaba,

Kodlara şu işlemide ekledim hocam,

   .Cells(son, "D") = "false"
            .Cells(son + 1, "D") = "true"

ancak çalışma sayfasına türkçelerini yanlış-doğru olarak yazdı.
Kodlarda olduğu gibi false-true yazdırmak için ne yapmalıyım.

 

[Ömer]

Eğer hücrede "True" şeklinde görünmesinde bir mahsur yoksa,

.Cells(son + 1, "D") = """" & True & """"

bu şekilde kullanmalısınız.

Yada, D sütununun biçimini metin formatına çevirmelisiniz.

Formata çevirme işlemini manuel yada koda ekleyerek yapabilirsiniz. Eğer kodlara ekmek istiyorsanız.

For j döngüsünde

End If satırından önce,

.Columns("D:D").NumberFormat = "@"

bu kodu ilave edersiniz..

.

 

[Emir Hüseyin Çoban]

Sy Ömer Hocam çok teşekkürler, dediğiniz gibi kodlara ekleme yaptım. Sorunumu yine çözdünüz.
Hocam bir başlık açtım altında defalarca sorular sordum, zahmetler veriyorum.
İlgi ve anlayışınız için teşekkür ederim.

 

[Ömer]

Rica ederim, iyi çalışmalar..

 

[blodydt]

Merhaba,

Tahmin ettigim sekilde ise bende bu konudan yararlanabilirim fakat kaynak dosyayi inceleyemiyorum; cunku isyerimde RAR uzantili dosyalari kullanamiyorum, (ve rar kullanmak icin olan programi yukleyemiyorum, kendilerince bir guvenlik sistemi var firmanin). Rica etsem zipli olarak veya sadece excel dosyasi olarak yukleyebilir misiniz?

Tesekkur ederim

 

[Ömer]

Merhaba,

Dosya zip olarak ektedir.

.