Макрос вставки столбцов в нескольких таблицах - 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