Xin chỉ code tự thêm 1 cột trống về bên trái mỗi bảng (2 người xem)

[vijnanamatrata]

Xin chào mọi người,

Mình có một việc cần tự động hóa bằng macro và đã viết code thử nhưng chưa thành công, mong mọi người giúp đỡ.

Mình có gửi kèm file mẫu, trong đó có 3 sheet: ban_dau_1, ban_dau_2 và ket_qua. Sheet ban_dau_1 và ban_dau_2 y hệt nhau. Mình cần định dạng các bảng trong 2 sheet ban_dau cho ra giống y như sheet ket_qua.

Cụ thể là có những cái này cần định dạng:
- Thêm 1 dòng trống ở trên cùng (đã làm được)
- Đóng băng các hàng tiêu đề (đã làm được)
- Và đây là cái mình chưa làm được: Tự thêm 1 cột trống về bên trái mỗi bảng. Cột thêm vào không có fill color và không có border gì cả. (Từng bảng ở đây được phân biệt bằng các merged cell ở hàng trên cùng).
- Ngoài ra nếu được xin chỉ mình cách xác định vị trí cột dữ liệu cuối cùng bên phải của sheet và hàng dữ liệu cuối cùng phía dưới của sheet để tự động ẩn phần sheet trống đi.

Xin cảm ơn mọi người rất nhiều.


Sau đây là code của mình (trong module ThisWorkbook):
Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim bScrUpdate As Boolean
Dim ws As Worksheet
Dim rng As Range

Application.EnableCancelKey = xlDisabled 'disable ESC key
bScrUpdate = Application.ScreenUpdating
If bScrUpdate = True Then Application.ScreenUpdating = False
Application.DisplayAlerts = False

For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "ket_qua" Then
ws.Select
Rows("1:1").Insert Shift:=xlDown

Range("A4").Select
ActiveWindow.FreezePanes = True

For Each rng In Rows("2:2").Cells
If rng.MergeCells Then
rng.MergeArea.Cells(1, 1).Select
Selection.Offset(-1, 1).EntireColumn.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
End If
Next rng
End If
Next ws

Application.DisplayAlerts = True
If Not Application.ScreenUpdating = bScrUpdate _
Then Application.ScreenUpdating = bScrUpdate
Application.EnableCancelKey = xlInterrupt 'enable ESC key
End Sub