Belli sayfaları tek bir sayfada alt alta birleştirme

[obediah]

Merhaba arkadaşlar. Yardımınıza ihtiyacım var. Ekteki dosyada rapor hazırla bölümünde Tüm sayfaları alt alta birleştir dediğimde bütün sekmeleri alt alta combined adlı bir sayfada birleştiriyor. Ama ben sadece sınıfların olduğu sayfalar alt alta birleşsin istiyorum.

For i = 3 to Sheets.Count -3

yapıyorum ama işe yaramıyor.

Yardımcı olursanız sevinirim.

 

[Ömer]

Merhaba,

Kodları detaylı incelemedim, yapmak istediğiniz için aşağıdaki kırmızı ilaveler yeterli olacaktır.

Sub Combine()
Dim J As Integer
On Error Resume Next
Sheets(1).Select
Worksheets.Add ' add a sheet in first place
Sheets(1).Name = "Combined"
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
For J = [COLOR=blue]1 To Sheets.Count[/COLOR] 
[COLOR=red]If IsNumeric(Left(Sheets(J).Name, 1)) = True Then
[/COLOR]Sheets(J).Activate ' make the sheet active
Range("A1").Select
Selection.CurrentRegion.Select ' select all cells in this sheets
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
[COLOR=red]End If[/COLOR]
Next
End Sub

 

[obediah]

Yanıtınız için çok teşekkür ederim. 3 sorum var.

1. sizin verdiğiniz kodu kullandığımda da dosyadaki "Başlangıç" adlı sayfanın 1. satırını içine alıyor. Bunu engelleyebilir miyim ?
2. Bu işlemi tablonun sütun genişliği yapısını bozmadan nasıl yaparım? (past special columnwidht olayı)
3. Bir klasörde aynı bu türden yaklaşık 30 tane dosya olacak. Bütün bu dosyalardaki 1-A, 1-B gibi bütün sınıfları tek sayfada alt alta nasıl toplarım?

Kusura bakmayın kafanızı ağrıttım. Yardımınız için sağolun.

 

[obediah]

Tekrar Merhaba. Yukaridaki dosyamda görmüş olduğunuz gibi 8-a, 8-b gibi sınıf isimleri var. Ben bu Sınıf isimlerinin olduğu sekmeleri alttaki kod ile tek sayfada toplamayı başardım.

Sub Combine2()
On Error Resume Next
Set sc = ThisWorkbook.Worksheets("Combined")
If sc Is Nothing Then
    Set sc = Worksheets.Add(Worksheets(1))
    sc.Name = "Combined"
Else
    sc.AutoFilterMode = False
    sc.Cells.Delete
End If

For Each sh In ThisWorkbook.Worksheets ' from sheet 2 to last sheet
If sh.Name Like "#-[A-Z]" Then
    Set r1 = sc.Range("A65536").End(xlUp)(2)
    sh.UsedRange.Copy r1
    sh.UsedRange.Copy
    r1.PasteSpecial xlPasteColumnWidths
End If
Next
End Sub

Ancak isteğim şey bu komutu bir klasörde bulunan yaklaşık 30 tane kapalı excel dosyasında çalıştırmak. Bunu nasıl yapabilirim? Teşekkürler.

 

[Seli]

Tekrar Merhaba. Yukaridaki dosyamda görmüş olduğunuz gibi 8-a, 8-b gibi sınıf isimleri var. Ben bu Sınıf isimlerinin olduğu sekmeleri alttaki kod ile tek sayfada toplamayı başardım.

Sub Combine2()
On Error Resume Next
Set sc = ThisWorkbook.Worksheets("Combined")
If sc Is Nothing Then
    Set sc = Worksheets.Add(Worksheets(1))
    sc.Name = "Combined"
Else
    sc.AutoFilterMode = False
    sc.Cells.Delete
End If

For Each sh In ThisWorkbook.Worksheets ' from sheet 2 to last sheet
If sh.Name Like "#-[A-Z]" Then
    Set r1 = sc.Range("A65536").End(xlUp)(2)
    sh.UsedRange.Copy r1
    sh.UsedRange.Copy
    r1.PasteSpecial xlPasteColumnWidths
End If
Next
End Sub

Ancak isteğim şey bu komutu bir klasörde bulunan yaklaşık 30 tane kapalı excel dosyasında çalıştırmak. Bunu nasıl yapabilirim? Teşekkürler.

Hocam burda veri alacağımız sayfalar 2. satırdan balşıyor ise nasıl düzenlememiz gerekir? Teşekkür ederim.