DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub SayfaBirlestir()
Dim arr As Variant
Dim syf As Worksheet
Dim Sat As Long
Dim sh As Worksheet
On Error Resume Next
If CBool(Len(Worksheets("Tüm Sayfalar").Name) > 0) = False Then
Sheets.Add Before:=Sheets(1)
ActiveSheet.Name = "Tüm Sayfalar"
Else
Sheets("Tüm Sayfalar").Cells.ClearContents
End If
On Error GoTo 0
Set sh = Sheets("Tüm Sayfalar")
For Each syf In Worksheets
If Not syf.Name = sh.Name Then
arr = syf.Range("A1").CurrentRegion.Value
Sat = sh.Cells(Rows.Count, "A").End(3).Row + 1
sh.Range("A" & Sat).Resize(UBound(arr, 1), UBound(arr, 2)) = arr
End If
Next syf
sh.Select
MsgBox "Tüm Sayfalar Birleştirilmiştir....", vbInformation
End Sub
çalışma kitabında boş bir sayfa - geliştirici - visual basic - insert - modüle - kodu kopyalayıp yapıştırdım (burada kaldım)