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

Узнай цену своей работы

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

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

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

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

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

12   голосов , оценка 3.75 из 5
Похожие ответы