Soru sheetleri sıralama

[polist]

selamlar ,

abilerim bir excel de 50 civarı sheet var

bunların hepsini tek bir sheete alt-alta listemek istiyorum

yardımcı olabilirmisiniz ..

 

[Necdet]

Merhaba,

Listelenecek sayfa adını da belirtin ki kod yazacak arkadaş onu dikkate alsın.

 

[polist]

Merhaba,

Listelenecek sayfa adını da belirtin ki kod yazacak arkadaş onu dikkate alsın.

abi acemiyim , sayfa adını filan bilmiyorum.

örnek bir dosya ekledim , umarım kastettiğiniz budur

 

[polist]

sheet.xlsx dosyasını indir - download

sheet.xlsx dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s2.dosya.tc

örnek dosya ekledim.

örnek dosyada
sheet1 den 7 ye kadar ama var olan tüm sheetleri ( 30-40 kadar olabilir bende bilmiyorum)

toplu adlı sheete alt alta eklemek istiyorum ( sheetlerin tamamı text karakterinde matematiksel hiç bir işlem yok, satır sayısı değişken 50 satır olanda var 100 satır olanda var )

bu mümkünmüdür

 

[Necdet]

Merhaba,
Aşağıdaki kodları bir modüle kopyalayıp deneyiniz.

Sub TumVeriler()

    Dim Syf As Worksheet, _
        ShT As Worksheet, _
        i   As Long, _
        j   As Long
   
    Set ShT = Sheets("toplu")
    ShT.Cells.ClearContents
   
    For Each Syf In Worksheets
        If Not Syf.Name = "toplu" Then
            i = ShT.Cells(Rows.Count, "A").End(3).Row + 1
            j = Syf.Cells(Rows.Count, "A").End(3).Row
            Syf.Range("A1:A" & j).Copy ShT.Range("A" & i)
        End If
    Next Syf
   
    MsgBox "İşlem Bitti..."
   
End Sub

 

[polist]

Merhaba,
Aşağıdaki kodları bir modüle kopyalayıp deneyiniz.

Sub TumVeriler()

    Dim Syf As Worksheet, _
        ShT As Worksheet, _
        i   As Long, _
        j   As Long
   
    Set ShT = Sheets("toplu")
    ShT.Cells.ClearContents
   
    For Each Syf In Worksheets
        If Not Syf.Name = "toplu" Then
            i = ShT.Cells(Rows.Count, "A").End(3).Row + 1
            j = Syf.Cells(Rows.Count, "A").End(3).Row
            Syf.Range("A1:A" & i).Copy ShT.Range("A" & i)
        End If
    Next Syf
   
    MsgBox "İşlem Bitti..."
   
End Sub

abi teşekkür ederim eline sağlık .

 

[polist]

Merhaba,
Aşağıdaki kodları bir modüle kopyalayıp deneyiniz.

Sub TumVeriler()

    Dim Syf As Worksheet, _
        ShT As Worksheet, _
        i   As Long, _
        j   As Long
   
    Set ShT = Sheets("toplu")
    ShT.Cells.ClearContents
   
    For Each Syf In Worksheets
        If Not Syf.Name = "toplu" Then
            i = ShT.Cells(Rows.Count, "A").End(3).Row + 1
            j = Syf.Cells(Rows.Count, "A").End(3).Row
            Syf.Range("A1:A" & i).Copy ShT.Range("A" & i)
        End If
    Next Syf
   
    MsgBox "İşlem Bitti..."
   
End Sub

https://s5.dosya.tc/server6/isrc1s/sheet.xlsm.html

Necdet abi ,

örnek bir çalışma yapayım dedim .

makro istediğim şekilde çalışmadı .

sanırım hata bendedir . nerde yanlış yapmış olabilirim abi ,

bakabilirsen sevinirim ,

 

[YUSUF44]

Syf.Range("A1:A" & i).Copy ShT.Range("A" & i)

Satırında ilk değişken i değil j olmalı:

Syf.Range("A1:A" & j).Copy ShT.Range("A" & i)

 

[Necdet]

Hata bende denemeden gönderince karıştırmışım, Sayın YUSUF44 hatamı düzeltmiş, sağolsun.
Ben de düzeltilmiş halini ilk mesajımda yeniledim.

 

[polist]

Hata bende denemeden gönderince karıştırmışım, Sayın YUSUF44 hatamı düzeltmiş, sağolsun.
Ben de düzeltilmiş halini ilk mesajımda yeniledim.

abi sizler olmasanız biz ne yaparız , elinize sağlık canınız saolsun

Syf.Range("A1:A" & i).Copy ShT.Range("A" & i)

Satırında ilk değişken i değil j olmalı:

Syf.Range("A1:A" & j).Copy ShT.Range("A" & i)

yusuf abi saol ellerin dert görmesin ,