Belirli Sayfaları İstenen Sayfada Alt alta Birleştirme Makrosu

[khthonik]

Merhabalar,

Çok sayfalı excelimdeki sadece 3 sayfayı (SLİKRSK, SSZAMBR ve SSZSVKT sayfa adları), 1 sayfada (IRSDKM sayfa adı) altalta birleştirmek (4 sayfanın da sütun sayısı ve biçimi aynı, satır sayısı farklı) istiyorum.

SLİKRSK, SSZAMBR ve SSZSVKT sayfalarına sevk edilecek malzemelerin bilgileri işlenmektedir. Bu malzemeler sevk edileceği zaman IRSDKM sayfasına altalta gelmiş olan verilerin yanlarına irsaliye no, tarih vb sevk verileri işlenecektir.

Saygılar...

 

[yanginci34]

Örnek dosyanızı yüklemeniz gerekli. Çünkü dosyanızın yapısına göre yardım şekli değişir. Eğer foruma üye değilseniz https://dosya.co/ gibi sitelere dosya yükleyip burada link paylaşın bakalım.

 

[khthonik]

Günaydınlar,
Link eklenmiştir.
[URL=https://dosya.co/us10q3c8hd2t/Giden_İrsaliye_Takip.xlsm.html]Giden İrsaliye Takip.xlsm - 766 KB[/URL]
Saygılar..

 

[Korhan Ayhan]

Sayfalardaki dolu hücre kontrolü için "B" sütunu dikkate alınmıştır.

Deneyiniz.

Option Explicit

Sub Aktar()
    Dim Onay As Byte, S1 As Worksheet, Sayfa As Worksheet, Satir As Long, Son As Long
    
    Onay = MsgBox("Sayfadaki eski veriler silinsin mi?", vbYesNo + vbCritical + vbDefaultButton2)
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Set S1 = Sheets("IRSDKM")
    
    If Onay = vbYes Then
        S1.Range("A3:R" & S1.Rows.Count, "T3:AQ" & S1.Rows.Count).ClearContents
        Satir = 3
    Else
        Satir = S1.Cells(S1.Rows.Count, 1).End(3).Row + 1
    End If
    
    For Each Sayfa In Sheets(Array("SLIKRSK", "SSZAMBR", "SSZSVKT"))
        If Sayfa.Range("B3") <> "" Then
            Son = Sayfa.Cells(Sayfa.Rows.Count, 2).End(3).Row
            Sayfa.Range("A3:R" & Son).Copy S1.Cells(Satir, 1)
            Satir = S1.Cells(S1.Rows.Count, 1).End(3).Row + 1
        End If
    Next
    
    Set S1 = Nothing
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
    MsgBox "Aktarım işlemi tamamlanmıştır.", vbInformation
End Sub

 

[tahsinanarat]

Sn. Korhan hocam SSZAMBR isimli sayfayı almadığını fark ettim, neden acaba.
bir kaç denemeden sonra
Satir = S1.Cells(S1.Rows.Count, 1).End(3).Row + 1
Satir = S1.Cells(S1.Rows.Count, 2).End(3).Row + 1

yapınca oldu. Teşekkürler.

 

[khthonik]

Merhabalar,

Öncelikle ilginize teşekkür ederim.

1. IRSDKM sayfasına buton yaptım. Butona bastığımda 3 sayfayı da alt alta diziyor. Fakat 2. kez butona bastığımda, 3 sayfayı da tekrar IRSDKM ye ekliyor. Her butona basışta ekleme yapıyor. Onları daha önce eklemişti. Bir daha bir daha eklemesine gerek yok ki... Örneğin; kodun, SLIKRSK sayfasını 200. satıra kadar IRSDKM sayfasına zaten eklemiştin sonrasına bak varsa taşı yoksa elleme gibi düşünmesi lazım IRSDKM sayfasına mevcut veri taşındıktan sonra o veri kendi satırında sabit kalmalı ki yanına irsaliye bilgileri yazıldığında satır değişip te veri kayması olmasın. Bundan sonra sadece yeni eklenen veriler IRSDKM sayfasına taşınsın.. Yani aktar değil de güncelle gibi bir mantık olması gerekiyordu.
2. "Sayfadaki eski veriler silinsin mi?" onayına gerek yok. Sadece Güncelleme yapıldı diye mesaj gözükmesi yeterlidir. Çünkü "SLIKRSK", "SSZAMBR", "SSZSVKT" sayfalarındaki verilerin silinmemesi lazım. Çünkü 3 sayfayı da farklı kullanıcılar kullanıyor, önceden ne göndermiştim diye kendi sayfasından geçmişe bakması gerekecektir.

Not: 3 sayfaya, 3 kullanıcının girdiği verilere göre oluşan IRSDKM sayfasına 4. kullanıcı irsaliye bilgilerini işliyor ve irsaliye formatımıza aktarıyor...

Saygılar..

 

[Korhan Ayhan]

Merhaba,

Dosyanızın yapısına siz daha hakimsiniz. Sizin yönlendirmeniz doğru aktarım kodunun ortaya çıkmasını sağlayacaktır.

Kodun verdiği "Eski veriler silinsin mi?" uyarısı daha önce aktarılan veriler içindir. Evet derseniz "IRSDKM" sayfasındaki tüm veri silinir. Bu uyarıyı kaldırabiliriz.

2. ve 3. sekmedeki PROJE NO bölümlerinde aynı numara yazıyor. Bunlar aktarılırken nasıl bir yol izlenecek?

Adım adım işlem sırasını yazarsanız daha iyi sonuç alabiliriz.

 

[khthonik]

Sütun sayısı ve düzeni aynı olan "SLIKRSK", "SSZAMBR", "SSZSVKT" sayfalarına "A3:R65536" aralığına malzeme bilgileri girilmektedir. Bu üç sayfaya her girilen yeni bilgiyi "IRSDKM" sayfasına alt alta yedeklenmesini istemekteyim.

Başka bir excelimde, bir sayfayı başka bir sayfaya yedeklemeyi alttaki kodlarla yapmaktayım. Üç farklı sayfayı tek sayfaya birleştirme bu koda benzer olarak şöyle olabilir; ""SLIKRSK", "SSZAMBR", "SSZSVKT" sayfalarındaki Q sütununa veri girince makro tetiklensin, S sütununa satırı (Örneğin; A3:R3) birleştirsin... S sütununda, farklı ise IRSDKM sayfasında "A3:R65536" aralığına ilk boş satıra veriyi taşısın..."

Private Sub Worksheet_Change(ByVal Target As Excel.Range) 'P2:Q65536 aralığında işlem yapılırsa makro tetiklenir. Bu tetikleme ile B,C,D,E,F,G,H,I,J,K,L,M,N, ve O sütun verilerinde değişiklik varsa DT sayfasına yazar.
On Error Resume Next
Application.EnableEvents = False
Set ws1 = Worksheets("KKNM")
Set ws2 = Worksheets("KDT")
ws1.Unprotect Password:="***"
ws2.Unprotect Password:="***"
If Not Intersect(Target, Range("P2:Q65536")) Is Nothing Then
sat = Target.Row
Cells(sat, "s") = Cells(sat, "b") & Cells(sat, "c") & Cells(sat, "d") & Cells(sat, "e") & Cells(sat, "f") & Cells(sat, "g") & Cells(sat, "h") & Cells(sat, "ı") & Cells(sat, "j") & Cells(sat, "k") & Cells(sat, "l") & Cells(sat, "m") & Cells(sat, "n") & Cells(sat, "o") & Cells(sat, "r")
sonn = Sheets("KDT").Range("s65536").End(xlUp).Row + 1
If WorksheetFunction.CountIf(Sheets("KDT").Range("s2:s" & sonn), Cells(sat, "s")) = 0 Then
sonsatir = Sheets("KDT").Range("c65536").End(xlUp).Row + 1
Sheets("KDT").Cells(sonsatir, 1) = sonsatir - 1
For p = 2 To 19
Sheets("KDT").Cells(sonsatir, p) = Cells(sat, p)
Next p
End If
End If
Application.EnableEvents = True
ws1.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True, Password:="***"
ws2.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True, Password:="***"
End Sub

 

[khthonik]

Günaydınlar,
Yukarıdaki verdiğim kodu her sayfanın kendi vba sına yapıştırarak ve bu kodu sayfanın kendi sütun düzenine göre uyarlayarak sorunu çözmüş bulunmaktayım.
Her sayfa münferit olarak çalışmakta ve verisini tek sayfaya aktarmaktadır. Zaten kod, birleştirme yapılan tek sayfaya ilk boş satıra yapıştır mantığı ile çalıştığı için verinin kaç sayfadan geldiğinin bir önemi yoktur. İster bir sayfa ister 3 sayfa olsun...
Kafamı karıştıran 3 sayfayı tek sayfaya alt alta birleştirme sorunsalı yersizmiş, cevap zaten elimin altındaymış...
İlginize teşekkür ederim, Saygılar...