DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Option Explicit
Sub TUM_VERILERI_TEK_SAYFAYA_AKTAR()
Dim S1 As Worksheet, Sayfa As Worksheet, X As Long, Satir As Long
Application.ScreenUpdating = False
Set S1 = Sheets("ÖZET")
S1.Range("A2:S" & Rows.Count).ClearContents
Satir = 2
For Each Sayfa In ThisWorkbook.Worksheets
If Sayfa.Name <> "ÖZET" Then
For X = 2 To Sayfa.Cells(Rows.Count, 1).End(3).Row
If Sayfa.Cells(X, "S") <> 0 Then
Sayfa.Range("A" & X & ":S" & X).Copy S1.Cells(Satir, 1)
Satir = Satir + 1
End If
Next
End If
Next
S1.Cells.EntireColumn.AutoFit
Set S1 = Nothing
Application.ScreenUpdating = True
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub