Tabloları Birleştirmek

[Ghaldszar]

Selamlar

Bir sorum var.
Excel'de Sheet 1 de bir tablom olduğunu düşünelim. Satır sayısı belli değil.
Sheet 2 de de bir tablom var. Onun da satır sayısı belli değil.
Ben bu iki tabloyu alt alta otomatik olarak Sheet 3' e ya da başka bir excel dosyaya yazmak istiyorum. Arada boşluk kalmadan. Böyle bir şey mümkün mü?
Sheet 1 ve Sheet 2 deki tablolar sürekli değişecek. Copy/Paste ile farklı 2 tablo koyacağım oraya, tabii aynı formatta. Koyduğum tablolarda sütun sayısı sabit kalacak ama satır sayısı değişecek. Excel dosya o iki tabloyu Sheet 3 de yada başka bir dosyada alt alta koyup tek bir tablo haline getirecek.
Sheet 3 ' e tabloyu böyle aktarmamın amacı onun üzerinden formulizasyon ile başka tablolara veri aktarımı yapacağım.
Mümkün müdür?

 

[Ömer]

Merhaba,

Mümkündür. Sorunuzu destekleyen küçük bir excel dosyası eklermisiniz.

 

[Ghaldszar]

Örnek Dosya ektedir.

Bu dosyada Ayakkabı, Mont-E ve Mont-B sayfalarındaki tabloların alt alta Fiyat Listesi sayfasındaki tabloya otomatik olarak aktarılması lazım.Fakat bunu yaparken arada boş satır kalmıyo olması gerek ve mesela Ayakkabı sayfasına bir satır daha eklediğimde ya da copy/paste yaparak başka bir yerden verileri alıp o 3 sayfadan birine eklediğimde fiyat listesinde otomatik update olması gerek.

 

[Ömer]

Merhaba,

Module kopyalayıp butona bağlayıp çalıştırın.

Sub Birlestir()
    
    Dim i As Long, son As Long, sat As Long
    
    Application.ScreenUpdating = False
    Sheets("Fiyat Listesi").Select
    
    Range("A2:F" & Rows.Count).Clear
    
    For i = 1 To Worksheets.Count
        With Sheets(i)
            If .Name <> "Fiyat Listesi" Then
                son = .Cells(Rows.Count, "A").End(xlUp).Row
                sat = Cells(Rows.Count, "A").End(xlUp).Row + 1
                .Range("A2:F" & son).Copy Range("A" & sat)
            End If
        End With
    Next i
 
End Sub

.

 

[Ghaldszar]

Biraz açıklama yapabilir misin bu kod hakkında.
Burda sorduklarım genelde direk ihtiyacım olan kod olmuyor. Genelde farklı türde excel tablolarla çalıştığımdan yeni tablolara yeni şeyler ekleyerek yapıyorum ve burdan aldığım şeyler üzerinde ihtiyacım doğrultusunda değişiklikler yapıyorum.
Mesela bu kodu da bir çok excel dosyada farklı farklı şekillerde işime yarayacak. Fakat bu kod biraz beni aştı. Malesef anlayamadım tam olarak yaptığı işi ve nasıl yaptığını o uüzden değişiklik yapamıyorum. Braz açıklarsan üstünde değişiklk yapıp ya da soru sorabilirim.

 

[Ömer]

Çalışma sayfasındaki tüm saydalara bakar. "Fiyat Listesi" sayfası hariç tüm sayfaları "Fiyat Listesi" sayfasına alt alta yerleştirir.

Dosya ektedir.

.

 

[Ghaldszar]

Peki "Bu Sayfa" haricindeki sayfaları topla "Bu Sayfa"ya yaz
şeklinde değil de
"Şu sayfa 1" "Şu Sayfa 2" ve "Şu Sayfa 3" tekileri topla "Bu Sayfa"ya yaz şeklinde bir şey kursak o zaman hangi kısımda nasıl bir değişiklik yapmak gerekir.

 

[Ömer]

Dizi yazan bölümdeki, mavi işaretlediğim satırdaki sayfaları kırmızı işaretlediğim sayfaya yazar.

Sub Birlestir()
 
    Dim i As Integer, son As Long, sat As Long
    Dim syf As Worksheet, dizi()
 
    Application.ScreenUpdating = False
    Sheets("[COLOR=red]Fiyat Listesi[/COLOR]").Select
 
    Range("A2:F" & Rows.Count).Clear
 
    [COLOR=blue]dizi = Array("Ayakkabı", "Mont-E", "Mont-B")[/COLOR]
    For i = 0 To UBound(dizi)
        Set syf = Sheets(dizi(i))
        With syf
            son = .Cells(Rows.Count, "A").End(xlUp).Row
            sat = Cells(Rows.Count, "A").End(xlUp).Row + 1
            .Range("A2:F" & son).Copy Range("A" & sat)
        End With
    Next i
 
End Sub

.