Farklı Sekmeden Sırayla Veri Çekme

[baykan_m]

Merhaba Arkadaşlar,

Toplamda 8 sekmeden tek bir sayfaya verileri sırayla yazdırmak istiyorum. Bir çok formül denedim ancak başarılı olamadım, yardımcı olabilir misiniz?

 

[Muzaffer Ali]

Merhaba.
Aşağıdaki kodu bir module kopyalayıp çalıştırın.

Sub test()
    Dim syf As Worksheet
    Dim syfTum As Worksheet
    Dim SyfHaric As Variant
    Dim BakHaric As Integer
    Dim Haric As Boolean
    Dim SaySyf As Long
    Dim SayTum As Long
  
    '________________________________________________________________________________________
    SyfHaric = Array("TÜM ŞİRKET", "Sayfa1") ' Hariç tutulacak başka sayfa varsa isimlerini buraya ekleyiniz. "Sayfa1" i örnek olarak yazdım.
    '________________________________________________________________________________________
  
  
    Set syfTum = ThisWorkbook.Worksheets("TÜM ŞİRKET")
    For Each syf In ThisWorkbook.Worksheets
        Haric = False
        For BakHaric = 0 To UBound(SyfHaric)
            If syf.Name = SyfHaric(BakHaric) Then
                Haric = True
                Exit For
            End If
        Next
        If Not Haric Then
            SaySyf = syf.Cells(Rows.Count, "C").End(xlUp).Row
            SayTum = syfTum.Cells(Rows.Count, "B").End(xlUp).Row + 1
            If SayTum < 5 Then SayTum = 5
            syf.Range("B5:H" & SaySyf).Copy syfTum.Range("B" & SayTum)
        End If
    Next
End Sub

 

[baykan_m]

Çok teşekkür ederim emeğinize sağlık.