Sütun birleştirme

[yavuzkaraslan]

Farklı sayfalarda farklı sütunlarda bulunan değerleri tek bir sayfada tek bir sütunda alt alta nasıl sıralayabilirim.

 

[Necdet]

Farklı sayfalarda farklı sütunlarda bulunan değerleri tek bir sayfada tek bir sütunda alt alta nasıl sıralayabilirim.

Sorunuzu örnek dosya ile birlikte sorunuz ki daha sonra gereksiz yazışmalara neden olmasın.

 

[yavuzkaraslan]

sütun birleştirme

ek de yer alan dosyada 6 sayfada bulunan vereileri kopyala yapıştır yapmadan
birleştir sayfasında tek bir sutunda alt alta sıralayabilirmiyiz.
(örnek olarak 6 sayfa var ancak toplamı 1350 sayfa)

 

[yavuzkaraslan]

Farklı Sayfalardaki Sütunları Altalta Sıralama

ek de örnek olarak verilen dosyada 6 sayfa var.Ancak dosyanın tamamı 1500 sayfa civarında olduğu için kopyala yapıştır yerine daha kısa bir yol ile sütunlarda yer alan bilgileri alt alta sıralayabilirmiyiz.

 

[Necdet]

Merhaba,

Lütfen aynı konu için değişik başlıklar açmayınız.

Konuları ben birleştirdim.

Dosyanızda bazı hücrelerin arka planı sarı olarak biçimlendirilmiş, bunun bir anlamı var mı?

 

[Necdet]

Ses seda çıkmadı. Anladığımız şekilde kodlar yazıldı.

Birlestirilmis adı altında bir sayfanın olması gerekir. Sayfa sayısının çok olduğu nedeniyle sütuna kopyalanacak verinin çok olması halinde sonraki sütuna kopyalama yapar.

Sub Birlestir()
 
    Dim Syf As Worksheet, _
        Sh  As Worksheet, _
        i   As Long, _
        Sat As Long, _
        Kol As Integer, _
        k   As Integer, _
        j   As Integer
    
    On Error Resume Next
    
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    
    Set Sh = Sheets("Birlestirilmis")
    Sh.Cells.ClearContents
    j = 1
    
    For Each Syf In Worksheets
    
        If Not Syf.Name = "Birlestirilmis" Then
        
            Sat = Syf.Cells.Find("*", , , , xlByRows, xlPrevious).Row
            Kol = Syf.Cells.Find("*", , , , xlByColumns, xlPrevious).Column
            
            For k = 1 To Kol
                i = Sh.Cells(Rows.Count, j).End(3).Row + 1
                If i + Sat > Rows.Count - 2 Then
                    i = 2
                    j = j + 1
                End If
                Syf.Range(Syf.Cells(1, k), Syf.Cells(Sat, k)).Copy Sh.Cells(i, j)
            Next k
        End If
        
    Next Syf
    
    Sh.Cells.EntireColumn.AutoFit
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
    
    MsgBox "İşlem Tamamlanmıştır....", vbInformation, "Excel.Web.Tr"
    
End Sub

 

[Necdet]

Burada da geri dönüşüm yok, oldu muuuu olmadı mıııı vs vs vs