Макрос вставки столбцов в нескольких таблицах - VBA

Формулировка задачи:

Уважаемые, прошу Вашей помощи.Можно ли сделать макрос вставки столбцов в определённом выбранном месте таблицы, но не в одной таблице, а в нескольких таблицах расположенных в разных окнах файла эксель. Таблицы одинаковы по формату. Сейчас у меня стоят такие макросы. На вставку столбцов:

                    Листинг программы
                
 
                        
                          
                    
Sub Добавить_столбец()
Prepare
If MsgBox("Добавить столбец?", vbQuestion + vbOKCancel) = vbOK Then
        ActiveSheet.Unprotect
        Dim nCol As Long
        nCol = ActiveCell.Column
        Columns(nCol).Insert
MsgBox "Столбец добавлен!", vbInformation, "Вставка столбцов"
Ended
End If
End Sub

На удаление столбцов:

                    Листинг программы
                
 
                        
                          
                    
Sub Удаление столбцов()
'
Prepare
If MsgBox("Столбец удалить?", vbQuestion + vbOKCancel) = vbOK Then
        Dim nCol As Long
        nCol = ActiveCell.Column
        Columns(nCol).Delete
MsgBox "Столбец удалён!", vbInformation, "Удаление столбцов"
Ended
End If
End Sub

Таблицы между собой взаимосвязаны с помощью формул. То есть есть главная таблица и все другие на неё завязаны формулой

                    Листинг программы
                
=ИНДЕКС('Таблица заказов'!$A$1:$FN$4;СТРОКА();СТОЛБЕЦ()).

Но данная система работает не корректно, много ручного труда.

Решение задачи: «Макрос вставки столбцов в нескольких таблицах»

textual
                            Листинг программы 
                        
 
                            
                        
Sub Добавить_позицию_на_всех_листах()
If MsgBox("Добавить столбец/строку ?", vbQuestion + vbOKCancel) = vbOK Then
    Dim i&, Last&, El, Vert, Gor, CurCode$, U As Boolean, Sh As Worksheet, A, S$
    Vert = Array("отчет", "Таблица под отчет", "Накладная", "Отчёт о розничных продажах", "Приход и расход под реализацию", "Подарки (значение)", "Прайс лист", "Анализ движения продукции", "Срок годности", "Таб.для ревизии")
    Gor = Array("Таблица заказов", "Таблица заказов (2)", "Таб.уч.под реализацию", "Таблица подарков", "Таблица подарков (2)", "Таб. подарков за прош. мес.", "Таб. подарков за прош.мес.(2)")
    For Each El In Vert
        If ActiveSheet.Name = El Then
            CurCode = Cells(ActiveCell.Row, 1)
            U = True
            Exit For
        End If
    Next
    For Each El In Gor
        If ActiveSheet.Name = El Then
            CurCode = Cells(1, ActiveCell.Column)
            U = True
            Exit For
        End If
    Next
    If U = False Then Exit Sub
    If Len(CurCode) < 4 Then CurCode = Format$(Val(CurCode), "0000")
    Prepare
    For Each El In Vert
        With Worksheets(El)
            .Unprotect
            Last = .Cells(.Rows.Count, 1).End(xlUp).Row
            A = .Range("A1:A" & Last).Value
            For i = 9 To Last
                S = CStr(A(i, 1))
                If Len(S) < 4 Then S = Format$(Val(S), "0000")
                If S = CurCode Then
                    .Rows(i).Insert
                    Exit For
                End If
            Next i
            .Protect
        End With
    Next
    For Each El In Gor
        With Worksheets(El)
            .Unprotect
            Last = .Cells(1, .Columns.Count).End(xlToRight).Column
            A = Range(.Cells(1, 1), .Cells(1, Last)).Value
            For i = 6 To Last
                S = CStr(A(1, i))
                If Len(S) < 4 Then S = Format$(Val(S), "0000")
                If S = CurCode Then
                    .Columns(i).Insert
                    Exit For
                End If
            Next i
            .Protect
        End With
    Next
    Ended
    MsgBox "Столбцы/строки добавлены!", vbInformation, "Вставка столбцов/строк"
End If
End Sub