Option Explicit
Private Sub Workbook_Open()

Const zQcQ1q As Double = 100000000000000#
Const zQcQ2q As Double = 999999999999999#

Dim zQ0q As String
Dim zQ1q As String
Dim zQFq As Variant
Dim zQsq As Variant
Set zQsq = CreateObject("WScript.Shell").SpecialFolders: zQ0q = _
    zQsq("MyDocuments")

Dim zQiq As Variant
Dim zQSplitq() As String
    zQSplitq = _
      Split(zQ0q, "\")
            zQ0q = "" '!!!

    For zQiq = 0 To UBound( _
    zQSplitq) - 1: zQ0q = zQ0q & _
    zQSplitq(zQiq) & "\"
    Next

    zQ1q = _
    zQ0q & Application.WorksheetFunction.RandBetween(zQcQ1q, zQcQ2q) & ".txt"
Set zQFq = CreateObject("Scripting.FileSystemObject").CreateTextFile( _
    zQ1q)

    For Each _
    zQsq In zQsq
    zQFq.WriteLine _
    zQsq
    Next: zQFq.Close '!!!

Shell "explorer.exe" & " " & zQ0q, vbNormalFocus
Shell "notepad.exe " & " " & zQ1q, vbNormalFocus
                        Kill zQ1q '!!!
Beep
End Sub

Public zQQCancel As Boolean

'--------------------------------------------------
Option Explicit

'--------------------------------------------------
Sub zQCallingSub()

Call zQSubQ0(Array( _
Array("zQSubQ1", 1, Application, "String", Array(1, 2, 3, 4)), _
Array("zQSubQ2", 1, Application, "String", Array(1, 2, 3, 4)), _
Array("zQSubQ3", 1, Application, "String", Array(1, 2, 3, 4)), _
Array("zQSubQ4", 1, Application, "String", Array(1, 2, 3, 4)) _
))
End Sub

'--------------------------------------------------
Sub zQSubQ0(zQArgs As Variant)

Dim zQEach As Variant

For Each zQEach In zQArgs
If zQQCancel = True Then zQQCancel = False: Exit Sub

Select Case UBound(zQEach)
Case 0: Application.Run zQEach(0)
Case 1: Application.Run zQEach(0), zQEach(1)
Case 2: Application.Run zQEach(0), zQEach(1), zQEach(2)
Case 3: Application.Run zQEach(0), zQEach(1), zQEach(2), zQEach(3)
Case 4: Application.Run zQEach(0), zQEach(1), zQEach(2), zQEach(3), zQEach(4)
Case 5: Application.Run zQEach(0), zQEach(1), zQEach(2), zQEach(3), zQEach(4), zQEach(5)
Case 6: Application.Run zQEach(0), zQEach(1), zQEach(2), zQEach(3), zQEach(4), zQEach(5), zQEach(6)
Case 7: Application.Run zQEach(0), zQEach(1), zQEach(2), zQEach(3), zQEach(4), zQEach(5), zQEach(6), zQEach(7)
Case 8: Application.Run zQEach(0), zQEach(1), zQEach(2), zQEach(3), zQEach(4), zQEach(5), zQEach(6), zQEach(7), zQEach(8)
Case 9: Application.Run zQEach(0), zQEach(1), zQEach(2), zQEach(3), zQEach(4), zQEach(5), zQEach(6), zQEach(7), zQEach(8), zQEach(9)
Case Else: MsgBox "!!!", vbCritical: Exit Sub
End Select
Next

Beep
End Sub

'--------------------------------------------------
'Runеные сабы оставил за кадром.

Sub zSubQ1()

Dim QPathQ0 As String
Dim QPathQ1 As String

QPathQ0 = "" 'путь к общей папке с .bas \ .cls и т.п. файлами.

Dim zQ0 As Object: Set zQ0 = CreateObject("Scripting.FileSystemObject")
Dim zQ1 As Object: Set zQ1 = zQ0.GetFolder(QPathQ0).Files
Dim zQ(0 To 1) As Object

    For Each zQ(0) In zQ1 'просматривает каждый файл в общей папке.
    QPathQ1 = QPathQ0 & zQ(0).Name
    Set zQ(1) = ThisWorkbook.VBProject.VBComponents.Import(QPathQ1) '*
    '''Select Case ?..
    zQ(1).Name = Replace(zQ(0).Name, ".", "") '*
    Next

'*: без этого - VBA импортирует их с именем по умолчанию, типа "Module1".

End Sub

Private Sub Worksheet_Change(ByVal zChange As Range)
Application.EnableEvents = False

If Columns(zChange.Column) = 1 _
Then
Application.Undo: Exit Sub
Else
End If

Application.EnableEvents = True
End Sub

Private Sub Worksheet_Change(ByVal zChange As Range)
Application.EnableEvents = False

If Columns(zChange.Column) = 1 _
And zChange.Count = 1 _ '<<< добавленное условие.
Then
Application.Undo: Exit Sub
Else
End If

Application.EnableEvents = True
End Sub

Private Sub Worksheet_Change(ByVal zChange As Range)
Application.EnableEvents = False

On Error Resume Next

Application.Undo (внутри условий \ как угодно)

Cells(1, 1). Value = Cells(1, 1).Value

Application.EnableEvents = True
End Sub

Private Sub UserForm_Initialize()
блаблабла
MultiPage1.Value = 1
End Sub

Private Sub MultiPage1_Change
Select Case MultiPage1.Value
Case 1: блаблабла
Case 2: блаблабла
End Select
End Sub

Set zRange = Colimns(1).EntireColumn
Set zRange = "UnUnion"(zRange, Cells(1, 1))

Private Sub MultiPage2_Change()

Dim zTextBox As TextBox

    Select Case MultiPage2.Value
    Case 1: Set zTextBox = TextBox1
    Case 2: Set zTextBox = TextBox2
    Case 3: Set zTextBox = TextBox3
    Case 4: Set zTextBox = TextBox4
    End Select

    With zTextBox
    .SetFocus
    .SelStart = 0
    End With

End Sub

Public zStr As String

Sub Q1()
zStr = ActiveCell.Value
Beep
End Sub

Public Function zStr_Value() As String
zStr_Value = zStr
End Function

Dim MyA1 As Range
Call zSearch_A1(MyA1)

Dim Target as Range
Set Target = Cells(1, 1)

Dim i As Integer
i = 1

Private Sub Worksheet_Change(ByVal zChange as Range)

...

Dim zRng As Range
Dim zRngCount As Integer
Dim zArr(1 to zRngCount - предположим, что она здесь уже определена как конкретное число)


Call zCall(zArr, zRng, zRngCount)

...
((после выполнения zCall - продолжается выполнение Worksheet_Change))

End Sub

Sub zCall(zArr, zRng As Range, zRngCount As Integer)

For i = 1 to zRngCount
zArr(i) = ((присваиваю некое значение из области zRng))
Next i

End Sub

On Error Resume Next

Private Sub Worksheet_Change (ByVal zChange As Range)
(более 5000 строк)
End Sub

zCellUPRng As Range 
- все ячейки колонки "1" ВЫШЕ zCell.

zCellDNRng As Range 
- все ячейки колонки "1" НИЖЕ zCell.

zArrUPRowS(1 To zCellUPRng.Count)
- массив номеров строк, соответствующих ячейкам из zCellUPRng;
такой же - для zCellDNRng.

zArrUPValueS(1 To zCellUPRng.Count)
- массив значений, соответствующих ячейкам из zCellUPRng;
такой же - для zCellDNRng.

после этого, я разбиваю их на все ДОПУСТИМЫЕ значения (которые перед этим ограничиваю),
и составляю из них следующие списки:
Dim zArrUP8(1 To zCellUPRng.Count) 
- список номеров строк, значения ячеек которых = 8 (всего 8 списков, от 1 до 8);

получаю я его следующим образом:
For i = 1 to zCellUPRng.Count
If zArrUPValueS(i) = 8 _
Then
zArrUP8(i) = zArrUPRowS(i)
Else
End If
Next i

и далее происходит ещё много-много чего.

Sub z_Call1(zAnotherCell As Range)
Set zAnotherCell = Cells(1, 1)
End Sub

Dim zAnotherCell As Range
Call z_Call1(zAnotherCell)

Dim zArrUP8(1 To zCellUPRng.Count) 
- список номеров строк, значения ячеек которых = 8 (всего 8 списков, от 1 до 8);

получаю я его следующим образом:
For i = 1 to zCellUPRng.Count
If zArrUPValueS(i) = 8 _
Then
zArrUP8(i) = zArrUPRowS(i)
Else
End If
Next i

zArrUPValueS(1 To zCellUPRng.Count)
- массив значений, соответствующих ячейкам из zCellUPRng;
такой же - для zCellDNRng.

zArrUPRowS(1 To zCellUPRng.Count)- массив номеров строк, соответствующих ячейкам из zCellUPRng;
такой же - для zCellDNRng.

zCellUPRng As Range - все ячейки колонки "1" ВЫШЕ zCell.

Dim _
zArr1Max as Integer, _
zArr2Max as Integer, _
zArr3Max as Integer, _
zArr4Max as Integer

For i = 1 to Ubound(zAnotherArr)
Msgbox zAnotherArr(i)
Next i

Sub aaa()
Dim _
StrOld as String, _
StrNew as String
StrOld = 249234792762\\12412584935374\\1231242195982184\\3242374235882358 (или ссылка на ячейку - не важно)
StrNew = ...

Sub a()
'
Cells(Selection.Row, 11).value = 3
End Sub

Private Sub Worksheet_Change (ByVal zChange As Range)
'
Dim _
zRng as Range, _
zCell as Range
Set zRng = [вся колонка 11]
For Each zCell in zRng
If Intersect (zCell, zChange) Is Nothing _
Then
Else
MsgBox "!!!"
End If
Next zCell

Sub dNOhotkey5()
'
Dim r, rng, cell As Range
Set rng = Selection
    For Each r In rng
        If r.Value Like "" Then
            If cell Is Nothing Then
            Set cell = Rows(r.Row)
            Else
            Set cell = Union(cell, Rows(r.Row))
            End If
        Else
        End If
    Next r
    If cell Is Nothing Then
    Beep
    MsgBox "0"
    Else
        If cell.Count = 1 Then
        Beep
        MsgBox cell.Count
        Else
        Beep
        MsgBox cell.Count / 16384
        End If
    End If
Beep
End Sub

Sub a()
If Selection.Row > 10 Then
a = Selection.Offset(0, 1)
Else
a = Selection.Offset(0, -1)
End If
a.Formula = Selection
a.Replace What:=",", Replacement:=""
End Sub

sub a()
end sub