• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

tek sheete diğer sheetlerdeki verilerin sıralanması

Katılım
30 Ekim 2010
Mesajlar
122
Excel Vers. ve Dili
2003-2007
Selam Üstadlar

Sizlşerin deneyimlerine başvurma gereği duydum önemli bir konum var ekte bulunan tabloda ana tablo diye tabir ettiğim tek bir sheete diğer tabloların yani diğer sheetlerin altalta sıralanacak şekilde gelmesini sağlayacak formul yada sistem nasıl yapılabilir konu cok acil sizlerin yardımına ihtiyacım var

teşekkürler.
 

Ekli dosyalar

Selamlar,

Aşağıdaki kodu denermisiniz.

Kod:
Option Explicit
 
Sub AKTAR()
    Dim SAYFA As Worksheet, Satır As Long
    
    Application.ScreenUpdating = False
    
    Sheets("Ana Tablo").Select
    Range("A2:E65536").ClearContents
    Satır = 2
    
    For Each SAYFA In ThisWorkbook.Worksheets
        If SAYFA.Name <> "Ana Tablo" Then
            SAYFA.Range("A1:E" & SAYFA.Range("E65536").End(3).Row).Copy Cells(Satır, 1)
            Satır = Range("C65536").End(3).Row + 1
        End If
    Next
    
    Cells.EntireColumn.AutoFit
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Dosyanız ektedir.:cool:
Kod:
Sub sheetaktar_59()
Dim sat1 As Double, sat2 As Long
'evrengizlen@hotmail.con
'14.04.2011
Sheets(1).Select
Range("A1:E65536").Clear
Application.ScreenUpdating = False
sat1 = 1
For i = 2 To Worksheets.Count
    Cells(sat1, "A").Value = Sheets(i).Name
    Range("A" & sat1).Interior.Color = vbRed
    Range("A" & sat1).Font.Bold = True
    Range("A" & sat1).Font.Italic = True
    Range("A" & sat1).Font.Color = vbYellow
    sat1 = sat1 + 1
    sat2 = Sheets(i).Cells(65536, "A").End(xlUp).Row
    Sheets(i).Range("A1:E" & sat2).Copy Range("A" & sat1)
    sat1 = sat1 + sat2
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı." & vbLf & "evrengizlen@hotmail.com" & vbLf & "14.04.2011"
End Sub
 

Ekli dosyalar

Teşekkürler Ustadlar.
 
Geri
Üst