Hi everybody,

I have a task which needs automation with use of macro and I have written code to do it; however, my code could not do the task successfully. Therefore, I need your help now.

I attached a sample file, including 3 sheets: “start_1”, “start_2” and “result”. “start_1” and “start_2” are identical. I need to format tables in these two sheets “start” so that they look like exactly the “result” sheet.

In detail, here are tasks which need automating:
- Add 1 blank row at top (I have done it)
- Freeze title rows (I have done it)
- This is what I could not do: Add 1 blank column before each table. The added column must have no fill color and no border at all. (Each table here is identified by merged cells in the top title row)
- Also please show me how to determine the last column with data and the last row with data so that the blank outer space is hidden.

Thank you very much for your help.

Below is my code (in ThisWorkbook module):
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 <> "result" 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