Добрый день, взял код вот отсюда: https://www.excel-vba.ru/chto-umeet-excel/kazhdomu-polzovatelyu-svoj-listdiapazon/
пример: Tips_Macro_UsersRulesOnStart.xls (ПРАКТИЧЕСКИЙ ПРИМЕР С ИСПОЛЬЗОВАНИЕМ АДМИНИСТРАТОРА), нужно добавить код который позволит назначать пользователям состоящих в группе "user" строки или колонки как в примере Tips_Macro_Sheets_Hide_Rng_for_Users.xls (ДОСТУП К ОПРЕДЕЛЕННЫМ ЛИСТАМ И СКРЫТИЕ УКАЗАННЫХ СТРОК/СТОЛБЦОВ ) расположенный на той же странице. Мне удобно будет, если для этого будет использоваться [E] столбец
'---------------------------------------------------------------------------------------
' Module : frmIndicateUser
' DateTime : 11.05.2012 22:08
' Author : The_Prist(Щербаков Дмитрий)
' WebMoney - R298726502453; Яндекс.Деньги - 41001332272872
' http://www.excel-vba.ru
' Purpose : http://www.excel-vba.ru/chto-umeet-excel/kazhdomu-polzovatelyu-svoj-listdiapazon/
'---------------------------------------------------------------------------------------
Option Explicit
Private Sub cmndbCancel_Click()
Unload Me
' ThisWorkbook.Close
End Sub
Private Sub cmndbOK_Click()
Dim rFndRng As Range
Dim avItems
Dim lr As Long, li As Long
Dim oSheet As Worksheet
Dim sUserRange As String, sUserSheet As String, sSheets, s As String, ss As String
Dim sGroupe As String
Dim bShVis As Boolean
Application.ScreenUpdating = 0
With ThisWorkbook.Sheets(sUsersSH)
li = .Cells(.Rows.Count, 1).End(xlUp).Row
avItems = .Range(.Cells(2, 1), .Cells(li, 4)).Value
End With
If cmbUsers <> "" Then
For lr = 1 To UBound(avItems, 1)
s = LCase(avItems(lr, 1))
sGroupe = avItems(lr, 4)
If Len(s) Then
If s = LCase(Me.cmbUsers.Value) Then
ss = avItems(lr, 2)
If Me.txtbKod = ss Then
'АДМИН
If sGroupe = "admin" Then
For Each oSheet In ThisWorkbook.Sheets
oSheet.Visible = -1
Next
Else
'ПОЛЬЗОВАТЕЛЬ
sUserSheet = avItems(lr, 3)
sSheets = Split(sUserSheet, ";")
For Each oSheet In ThisWorkbook.Sheets
If oSheet.Name <> sMainSheet Then oSheet.Visible = 2
Next
For Each oSheet In ThisWorkbook.Sheets
If oSheet.Name <> sUsersSH Then
For li = 0 To UBound(sSheets)
If oSheet.Name = sSheets(li) Then
Sheets(sSheets(li)).Visible = -1
bShVis = True
End If
Next li
End If
Next
If bShVis Then
Sheets(sSheets(0)).Activate
Sheets(sMainSheet).Visible = 2
Else
MsgBox "Для указанного пользователя нет листов для работы!", vbCritical, "Ошибка": Exit Sub
End If
End If
Else
MsgBox "Неверно указан код!", vbCritical, "Ошибка": Exit Sub
End If
Exit For
End If
End If
Next lr
Else
MsgBox "Необходимо указать пользователя!", vbCritical, "Нет данных": Exit Sub
End If
bClose = False
Application.ScreenUpdating = 1
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim li As Long
With ThisWorkbook.Sheets(sUsersSH)
For li = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
cmbUsers.AddItem .Cells(li, 1)
Next li
End With
bClose = True
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If bClose = True Then ThisWorkbook.Close True
End Sub