Sürekli değişken sheetlerin oldugu tablo

[SeÖzGü]

Sürekli Sheet sayısı, Sütün ve Satır sayısı değişen çalışma kitabım var ve bunların içeriğinde ise 240.000 satır ve daha fazlası var bunları Tek Sheet düzenlemek için mevcut kod var ama onda da sütün değiştiği zaman hata veriyor makro kaydet ile yaptıgım için bunlarda çok yüklü olduğu için çok fazla zaman almakta bununla ilgili bana yardım edebilir misiniz lütfen..

 

[SeÖzGü]

Sub Macro1()
'
' Macro1 Macro
'

'
    Cells.Select
    With Selection.Font
        .Name = "Arial"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With Selection.Font
        .Name = "Arial"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Cells.EntireColumn.AutoFit
    Range("C5").Select
    Columns("C:C").ColumnWidth = 24.29
    Range("D15").Select
    Columns("E:E").ColumnWidth = 24
    Range("E13").Select
    Rows("1:1").RowHeight = 37.5
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Font.Bold = True
    Range("I8").Select
    Columns("I:I").ColumnWidth = 10
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("E1").Select
    Columns("E:E").ColumnWidth = 14.57
    Range("M1").Select
    Columns("L:L").ColumnWidth = 41
    ActiveWindow.ScrollColumn = 1
    Range("A1:P1784").Select
    Range("F12").Activate
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("F20").Select
    ActiveWindow.SmallScroll Down:=-105
    Range("F10").Select
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Columns("D:D").ColumnWidth = 16.71
    Columns("D:D").ColumnWidth = 14.29
    Range("C4").Select
    Columns("C:C").ColumnWidth = 15.29
    Cells.Select
    Cells.EntireRow.AutoFit
    Range("C9").Select
Dim i As Integer
Dim ssatir As Long, sdoluhcr As Long
For i = 1 To Sheets.Count
    Sheets(i).Select
ssatir = Cells.Find(What:="*", After:=Cells(1, 1), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
sdoluhcr = Cells.Find("*", , , , xlByColumns, xlPrevious).Column
Range(Cells(1, 1), Cells(ssatir, sdoluhcr)).Borders.LineStyle = xlContinuous
Next
End Sub

 

[SeÖzGü]

Konu Güncel olup Desteklerinizi rica ediyorum