Chỉnh lại code

[parkjun]

Dear các bạn,

Mình có thừa hưởng lại 1 đoạn code của người đi trc về format lại worksheet. Nhưng đoạn code này nó format toàn bộ các active worksheet nên nhiều khi hơi bất tiện.
Nên nhờ các bạn chỉnh lại để đoạn code này có thể format single worksheet nhé
Cảm ơn các bạn.

Sub FormatAllSheets()

Dim ws As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range

'Cycle through all open workbooks
For Each ws In Application.Worksheets
   ws.Activate
    
'Clear formatting of all cells
    Cells.Select
    Selection.ClearFormats
    Selection.RowHeight = 15
    With Selection.Font
        .Name = "Myriad Pro"
        .Size = 9
    End With

'Format header
Set StartCell = Range("A1")

'Find Last Row and Column
LastRow = ws.Cells(ws.Rows.Count, StartCell.Column).End(xlUp).Row
LastColumn = ws.Cells(StartCell.Row, ws.Columns.Count).End(xlToLeft).Column

ws.Range(StartCell, ws.Cells(1, LastColumn)).Select

    Selection.RowHeight = 42
    Selection.Interior.Color = 9916672
    Selection.Font.Color = 16777215
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
    End With

'Set zooming level
    ActiveWindow.Zoom = 100
    
'Set freeze pane
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    ActiveWindow.FreezePanes = True

'Select Range
ws.Range(StartCell, ws.Cells(LastRow, LastColumn)).Select

'Format table
ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes).Name = ActiveSheet.Name
ActiveSheet.ListObjects(ActiveSheet.Name).TableStyle = ""
Selection.ColumnWidth = 10
Rows("1:3").Select
Selection.Insert Shift:=xlDown
Rows("4:4").Select
Selection.Copy
Rows("1:1").Select
ActiveSheet.Paste
Next
End Sub

 

[FatBear]

Thử xem sao nhé bạn

Sub FormatSheets()

Dim ws As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range

'Cycle through all open workbooks
'For Each ws In Application.Worksheets
   ws.Activate
    
'Clear formatting of all cells
    Cells.Select
    Selection.ClearFormats
    Selection.RowHeight = 15
    With Selection.Font
        .Name = "Myriad Pro"
        .Size = 9
    End With

'Format header
Set StartCell = Range("A1")

'Find Last Row and Column
LastRow = ws.Cells(ws.Rows.Count, StartCell.Column).End(xlUp).Row
LastColumn = ws.Cells(StartCell.Row, ws.Columns.Count).End(xlToLeft).Column

ws.Range(StartCell, ws.Cells(1, LastColumn)).Select

    Selection.RowHeight = 42
    Selection.Interior.Color = 9916672
    Selection.Font.Color = 16777215
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
    End With

'Set zooming level
    ActiveWindow.Zoom = 100
    
'Set freeze pane
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    ActiveWindow.FreezePanes = True

'Select Range
ws.Range(StartCell, ws.Cells(LastRow, LastColumn)).Select

'Format table
ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes).Name = ActiveSheet.Name
ActiveSheet.ListObjects(ActiveSheet.Name).TableStyle = ""
Selection.ColumnWidth = 10
Rows("1:3").Select
Selection.Insert Shift:=xlDown
Rows("4:4").Select
Selection.Copy
Rows("1:1").Select
ActiveSheet.Paste
'Next
End Sub

 

[parkjun]

Thử xem sao nhé bạn

Sub FormatSheets()

Dim ws As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range

'Cycle through all open workbooks
'For Each ws In Application.Worksheets
   ws.Activate
   
'Clear formatting of all cells
    Cells.Select
    Selection.ClearFormats
    Selection.RowHeight = 15
    With Selection.Font
        .Name = "Myriad Pro"
        .Size = 9
    End With

'Format header
Set StartCell = Range("A1")

'Find Last Row and Column
LastRow = ws.Cells(ws.Rows.Count, StartCell.Column).End(xlUp).Row
LastColumn = ws.Cells(StartCell.Row, ws.Columns.Count).End(xlToLeft).Column

ws.Range(StartCell, ws.Cells(1, LastColumn)).Select

    Selection.RowHeight = 42
    Selection.Interior.Color = 9916672
    Selection.Font.Color = 16777215
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
    End With

'Set zooming level
    ActiveWindow.Zoom = 100
   
'Set freeze pane
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    ActiveWindow.FreezePanes = True

'Select Range
ws.Range(StartCell, ws.Cells(LastRow, LastColumn)).Select

'Format table
ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes).Name = ActiveSheet.Name
ActiveSheet.ListObjects(ActiveSheet.Name).TableStyle = ""
Selection.ColumnWidth = 10
Rows("1:3").Select
Selection.Insert Shift:=xlDown
Rows("4:4").Select
Selection.Copy
Rows("1:1").Select
ActiveSheet.Paste
'Next
End Sub

Dear bạn,

Mình chạy thì nó báo lỗi ở đoạn code dưới, bạn xem giúp mình nhé

 

[parkjun]

Có bác nào giúp mình với ạ

 

[FatBear]

Có bác nào giúp mình với ạ

Lần này chắc ok này. bạn ko cho file nên chẳng biết test kiểu gì ) thôi thì đành lần mò vậy

Sub FormatSheets()

'Dim ws As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range

'Cycle through all open workbooks
'For Each ws In Application.Worksheets
   'ws.Activate
Set ws = ActiveSheet
'Clear formatting of all cells
    Cells.Select
    Selection.ClearFormats
    Selection.RowHeight = 15
    With Selection.Font
        .Name = "Myriad Pro"
        .Size = 9
    End With

'Format headed
Set StartCell = Range("A1")

'Find Last Row and Column
LastRow = ws.Cells(ws.Rows.Count, StartCell.Column).End(xlUp).Row
LastColumn = ws.Cells(StartCell.Row, ws.Columns.Count).End(xlToLeft).Column

ws.Range(StartCell, ws.Cells(1, LastColumn)).Select

    Selection.RowHeight = 42
    Selection.Interior.Color = 9916672
    Selection.Font.Color = 16777215
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
    End With

'Set zooming level
    ActiveWindow.Zoom = 100
   
'Set freeze pane
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    ActiveWindow.FreezePanes = True

'Select Range
ws.Range(StartCell, ws.Cells(LastRow, LastColumn)).Select

'Format table
ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes).Name = ActiveSheet.Name
ActiveSheet.ListObjects(ActiveSheet.Name).TableStyle = ""
Selection.ColumnWidth = 10
Rows("1:3").Select
Selection.Insert Shift:=xlDown
Rows("4:4").Select
Selection.Copy
Rows("1:1").Select
ActiveSheet.Paste
'Next
End Sub

 

[parkjun]

Lần này chắc ok này. bạn ko cho file nên chẳng biết test kiểu gì ) thôi thì đành lần mò vậy

Sub FormatSheets()

'Dim ws As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range

'Cycle through all open workbooks
'For Each ws In Application.Worksheets
   'ws.Activate
Set ws = ActiveSheet
'Clear formatting of all cells
    Cells.Select
    Selection.ClearFormats
    Selection.RowHeight = 15
    With Selection.Font
        .Name = "Myriad Pro"
        .Size = 9
    End With

'Format headed
Set StartCell = Range("A1")

'Find Last Row and Column
LastRow = ws.Cells(ws.Rows.Count, StartCell.Column).End(xlUp).Row
LastColumn = ws.Cells(StartCell.Row, ws.Columns.Count).End(xlToLeft).Column

ws.Range(StartCell, ws.Cells(1, LastColumn)).Select

    Selection.RowHeight = 42
    Selection.Interior.Color = 9916672
    Selection.Font.Color = 16777215
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
    End With

'Set zooming level
    ActiveWindow.Zoom = 100
  
'Set freeze pane
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    ActiveWindow.FreezePanes = True

'Select Range
ws.Range(StartCell, ws.Cells(LastRow, LastColumn)).Select

'Format table
ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes).Name = ActiveSheet.Name
ActiveSheet.ListObjects(ActiveSheet.Name).TableStyle = ""
Selection.ColumnWidth = 10
Rows("1:3").Select
Selection.Insert Shift:=xlDown
Rows("4:4").Select
Selection.Copy
Rows("1:1").Select
ActiveSheet.Paste
'Next
End Sub

Dear bạn,

Vì mình thấy code này là để format tự động lại các sheet nên mình nghĩ là thử trên file nào cũng được và không có đính kèm file.
Code sau bạn chỉnh lại ok rồi
Tuy nhiên cho mình hỏi thêm xíu: code cũ nó bị 1 chỗ là Khi định dạng vùng dữ liệu thành Table thì có 1 số file nó ko xác định được dòng cuối cùng của file nên thình thoảng mình phải chỉnh tay lại size của Table, như trong file đính kèm thì khi chạy code nó chỉ nhận dòng 16673 là dòng cuối cùng trong khi đó dòng 17087 mới là dòng cuối. Nếu được thì bạn sửa giúp mình với nhé.
Cảm ơn bạn.