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..
Kod:
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
