Çalışma Sayfaları Birleştirme

[ErdemBakir24]

Merhaba,

Çok sayfalı bir listem var. Bu listeyi tek sayfada birleştirmem gerekiyor. Yardımcı olur musunuz?

Örnek Dosya:
http://s5.dosya.tc/server5/12t1mi/PAR_ARAC_GRUBU_HIDROLIK_LISTE_01-01-2017.xlsx.html

Teşekkürler.

 

[zafer]

Merhaba


http://www.excel.web.tr/f48/cok-sayfayy-birle-tirme-t164442.html

konuyu inceleyiz.

Ayrıca arama kutusuna çok sayfalı yazıp aratınız

 

[ErdemBakir24]

Zafer bey,

Göstermiş olduğunuz ilgi için teşekkür ederim.

Ancak attığınız linkteki kod tek bir sayfayı birleştiriyor benim isteğim 15 sayfanın hepsinin tek sayfada birleşmesi. Forumda bu konuya benzer başka bir konuda bulamadım.

Teşekkür ederim.

 

[Ömer BARAN]

Merhaba.

-- Belgenize, ANA SAYFA adında yeni bir sayfa ekleyin,
-- ALT+F11 tuşlarına basarak VBA ekranını açın,
-- Üstteki menüden INSERT => MODULE 'yi seçin,
-- Ekranın sağındaki boş alana aşağıdaki kod'u yapıştırın ve kod'u çalıştırın.

Sayfa sayısı ve sayfaların bazı özelliklerinden dolayı işlem biraz vakit alabilir,
benim denememde 90 saniye civarında işlem tamamlandı.
.

[B]Sub TEK_SAYFA()[/B]
Set a = Sheets("[B][COLOR="Blue"]ANA SAYFA[/COLOR][/B]")
zaman = Timer
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
a.Columns(1).ColumnWidth = 8.43: a.Columns(26).ColumnWidth = 8.43
a.Columns("B:I").ColumnWidth = 4.71: a.Columns("M:Y").ColumnWidth = 4.71
a.Columns("J:L").ColumnWidth = 2.43: a.Columns("AA:AC").ColumnWidth = 2.43
For Each s In ActiveWorkbook.Worksheets
    If s.Name <> "ANA SAYFA" Then
        asat = a.Cells(Rows.Count, 1).End(3).Row + 10
        s.Range("A1:AC" & s.Cells(Rows.Count, 1).End(3).Row + 10).Copy a.Cells(asat, 1)
    End If
Next
For sat = a.Cells(Rows.Count, 1).End(3).Row + 10 To 2 Step -1
    If WorksheetFunction.CountBlank(a.Range("A" & sat & ":AC" & sat)) = 29 And _
        a.Cells(sat - 1, 1) = "" Then a.Rows(sat & ":" & sat).Delete Shift:=xlUp
Next
a.Rows("1:1").Delete Shift:=xlUp
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "İşlem tamamlandı." & vbLf & "İşlem süresi:  " & _
    Format(Timer - zaman, "0.00") & "  saniye.", vbInformation, "..::.. Ömer BARAN ..::.."
[B]End Sub[/B]