В файле есть лист "Номенклатура" и один или несколько листов, у которых имена в виде чисел от 1 до 31 (это дни месяца). Кроме того, в файле есть и другие листы.
На листе "Номенклатура" и листах-днях одинаковое расположение строк.
Нужны макросы, которые бы запускались кнопками и делали следующее. При добавлении или удалении строки на листе "Номенклатура", должна добавляться или удаляться эта же строка на всех листах-днях. При этом остальные листы должны оставаться без изменений.
Нашел в интернете макросы для добавления/удаления строк с помощью кнопок, но эти макросы работают только с одним листом-днём. Не могу переделать его под свою задачу.
Макросы
Option Explicit
Const LinkedName = "2"
Private Sub cmdAddRow_Click()
AddRow
End Sub
Private Sub cmdDelRow_Click()
DelRow
End Sub
Private Sub AddRow()
If MsgBox("Добавить строку?", vbQuestion + vbOKCancel) = vbOK Then
Dim nRow As Long
nRow = ActiveCell.Row
Rows(nRow).Insert
With Sheets(LinkedName)
.Rows(nRow).Insert
.Range(.Cells(nRow, 1), .Cells(nRow, 4)).Formula = _
"=INDEX('" & ActiveSheet.Name & "'!$A:$D,ROW(),COLUMN())"
End With
End If
End Sub
Private Sub DelRow()
If MsgBox("Удалить строку?", vbQuestion + vbOKCancel) = vbOK Then
Dim nRow As Long
nRow = ActiveCell.Row
Rows(nRow).Delete
Sheets(LinkedName).Rows(nRow).Delete
End If
End Sub
Вместо этого кода:
.Range(.Cells(nRow, 1), .Cells(nRow, 4)).Formula = _
"=INDEX('" & ActiveSheet.Name & "'!$A:$D,ROW(),COLUMN())"
нужно написать код для вставки формулы, которая находится на листе-дне в столбце B:
=Номенклатура!B5
[вложение удалено администратором]
Макрос
Private Sub cmdAddRow_Click()
AddRow
End Sub
Private Sub cmdDelRow_Click()
DelRow
End Sub
Private Sub AddRow()
Dim sh_act As Worksheet, sh As Worksheet
Dim r As Long
'1. Сообщение для защиты от случайного запуска макроса.
If MsgBox("Добавить строку?", vbQuestion + vbYesNo) = vbNo Then Exit Sub
' Отключение монитора и формул, чтобы ускорить макрос.
Application.ScreenUpdating = False
Dim calc As Long: calc = Application.Calculation
'2. Присваиваем имя активному листу. Может быть так будет удобнее читать и писать код.
Set sh_act = ActiveSheet
'3. Запись номера активной строки.
r = ActiveCell.Row
'4. Вставка строки на основном листе.
sh_act.Rows(r).Insert
'5. Вставка строк на листах-днях.
For Each sh In Worksheets
' Если имя листа в виде числа.
If IsNumeric(sh.Name) Then
' Если имя листа - это число от 1 до 31.
If (sh.Name >= 1) And (sh.Name <= 31) Then
sh.Rows(r).Insert
sh.Cells(r, "B").FormulaR1C1 = "='" & sh_act.Name & "'!RC"
End If
End If
Next sh
' Включения.
Application.Calculation = calc
Application.ScreenUpdating = True
End Sub
Private Sub DelRow()
Dim sh_act As Worksheet, sh As Worksheet
Dim r As Long
'1. Сообщение для защиты от случайного запуска макроса.
If MsgBox("Удалить строку?", vbQuestion + vbYesNo) = vbNo Then Exit Sub
' Отключение монитора и формул, чтобы ускорить макрос.
Application.ScreenUpdating = False
Dim calc As Long: calc = Application.Calculation
'2. Присваиваем имя активному листу. Может быть так будет удобнее читать и писать код.
Set sh_act = ActiveSheet
'3. Запись номера активной строки.
r = ActiveCell.Row
'4. Удаление строки на основном листе.
sh_act.Rows(r).Delete
'5. Удаление строк на листах-днях.
For Each sh In Worksheets
' Если имя листа в виде числа.
If IsNumeric(sh.Name) Then
' Если имя листа - это число от 1 до 31.
If (sh.Name >= 1) And (sh.Name <= 31) Then
sh.Rows(r).Delete
End If
End If
Next sh
' Включения.
Application.Calculation = calc
Application.ScreenUpdating = True
End Sub