Макрос вставки столбцов в нескольких таблицах - 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
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д