Option Explicit
Dim EA As Excel.Application
Dim WB As Excel.Workbook
Dim WS As Excel.Worksheet
Dim strValue$, idcode&, strSQL$
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset

Public Sub transferAccPr()

Set EA = Excel.Application

EA.ScreenUpdating = False
EA.DisplayAlerts = False
EA.StatusBar = False

Set EA = Excel.Application
Set WB = EA.Workbooks("TestExcel.xlsm")
Set WS = WB.Worksheets("Лист1")

Set cn = New ADODB.Connection
cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\TestAccessBD.accdb;"
cn.Open

strValue = WS.Cells(2, 2).Value
idcode = WS.Cells(2, 1).Value

'strSQL = "SET NOCOUNT ON UPDATE Products SET [Item] = " & " '" & strValue & "'" & " WHERE Products.[CodeId]= 4"
strSQL = "UPDATE Products SET [Item] = " & " '" & strValue & "'" & " WHERE Products.[CodeId]= 4"

Set rs = cn.Execute(strSQL)

rs.Close

cn.Close

EA.ScreenUpdating = True
EA.DisplayAlerts = True

End Sub

nRegExp.Pattern = "\(.+\)"

Option Explicit
Dim WEA As Excel.Application
Dim WB As Excel.Workbook 
Dim WS As Excel.Worksheet 
Dim strValue$(1 To 10)
Dim nRegExp As RegExp


Public Sub replaceValue()

Set WEA = Excel.Application

WEA.ScreenUpdating = False
WEA.DisplayAlerts = False
WEA.StatusBar = False

Set WEA = Excel.Application
Set WB = WEA.Workbooks("Замен внутри скобок.xlsm")
Set WS = WB.Worksheets(1)

Set nRegExp = New RegExp

With WS

strValue(1) = .Cells(1, 1).Value
strValue(3) = Replace(strValue(1), "(*)", "")

nRegExp.Pattern = "(w\*)"
strValue(2) = nRegExp.Replace(strValue(1), "")


End With


WEA.ScreenUpdating = True
WEA.DisplayAlerts = True

End Sub

Dim WEA As Excel.Application
Dim WB As Excel.Workbook
Dim WS As Excel.Worksheet
Dim arrTest

Public Sub replaceValue()

Set WEA = Excel.Application

WEA.ScreenUpdating = False
WEA.DisplayAlerts = False
WEA.StatusBar = False

Set WEA = Excel.Application
Set WB = WEA.Workbooks("Длина массива.xlsm")
Set WS = WB.Worksheets(1)


arrTest = Array(1, 2, 3, 43, 5)
'i = arrTest.Ubound

WEA.ScreenUpdating = True
WEA.DisplayAlerts = True

End Sub

Dim WEA As Excel.Application
Dim WB As Excel.Workbook
Dim WS As Excel.Worksheet
Dim WSR As Range
Dim regDate As RegExp
Dim srtDate

Public Sub regExpProcedure()

Set WEA = Excel.Application

WEA.ScreenUpdating = False
WEA.DisplayAlerts = False

Set WEA = Excel.Application
Set WB = WEA.Workbooks("Ðåãóëÿðíîå âûðàæåíèå.xlsm")
Set WS = WB.Worksheets(1)
Set regDate = New RegExp

With WS

For Each WSR In Range(.Cells(1, 1), .Cells(1, 4))

        If WSR.Value Like regDate.Pattern = ("\w{2}.\w{2}.\w{4}") Then strDate = WSR.Value

Next WSR

End With

WEA.ScreenUpdating = True
WEA.DisplayAlerts = True

End Sub

 ReDim Preserve ARR_Extract(1 To 16, 1 To i)

Option Explicit
Option Base 1
Dim WEA As Excel.Application
Dim WB(1 To 30) As Excel.Workbook 
Dim WS(1 To 30) As Excel.Worksheet
Dim i&, y&, n&, k&
Dim iLastRow&(1 To 30) 
Dim iLastColumn&(1 To 30)

Public Sub test_Procedure()
Set WEA = Excel.Application

WEA.ScreenUpdating = False 
WEA.DisplayAlerts = False 

Set WEA = Excel.Application
Set WB(1) = WEA.Workbooks("Двухмерный динамичный массив.xlsm")
Set WS(1) = WB(1).Worksheets(1)

iLastRow(1) = LastRow_FA(WS(1), 1)
iLastColumn(1) = LastColumn_FA(WS(1), 1)

For n = 1 To iLastRow(1)      
    For i = 1 To iLastColumn(1)
        ReDim Preserve ARR_Extract(1 To n, 1 To i)    
        ARR_Extract(n, i) = WS(1).Cells(n, i).Value
    Next i
Next n

WEA.ScreenUpdating = True
WEA.DisplayAlerts = True
End Sub

Private Function LastColumn_FA(WSF As Excel.Worksheet, ifun&)
With WSF
LastColumn_FA = .Cells(ifun, .Columns.Count).End(xlToLeft).Column
End With
End Function

Private Function LastRow_FA(WSF As Excel.Worksheet, ifun&)
With WSF
LastRow_FA = .Cells(.Rows.Count, ifun).End(xlUp).Row
End With
End Function

BEGIN
  MultiUse = -1  'True
END

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
End

Dim WE As Excel.Workbook
Dim WS As Excel.Worksheet
Dim r1 As Range
Dim r2 As Range
Dim myMultiAreaRange As Range

Sub Proverka()

Set WE = Application.Workbooks("Диаграмма.xlsb")
Set WS = WE.Worksheets("Лист1")

With WS

Set r1 = .Range(.Cells(1, 1), .Cells(13, 2))
Set r2 = .Range(.Cells(1, 4), .Cells(13, 4))
Set myMultiAreaRange = Union(r1, r2)
myMultiAreaRange.Select
.Shapes.AddChart.Select
ActiveChart.ChartType = xlLine
ActiveChart.SetSourceData myMultiAreaRange

End With

End Sub

Dim WE As Excel.Workbook
Dim WS As Excel.Worksheet
Dim r1 As Range
Dim r2 As Range
Dim myMultiAreaRange As Range

Public Sub Proverka()

Set WE = Application.Workbooks("Диапазон.xlsm")
Set WS = WE.Worksheets("Лист1")

With WS

Set r1 = .Range(.Cells(1, 1), .Cells(13, 2))
Set r2 = .Range(.Cells(1, 4), .Cells(13, 4))
Set myMultiAreaRange = Union(r1, r2)
myMultiAreaRange.Select

End With

End Sub

Public Sub Proverka()

Set WE = Application.Workbooks("Диапазон.xlsm")
Set WS = WE.Worksheets("Лист1")

With WS

.Range(.Cells(1, 1), .Cells(13, 2)).Select 'работает

'.Range("A1:B13,D1:D14").Select 'работает
'.Range(.Cells(1, 1), .Cells(13, 2), .Cells(1, 4), .Cells(13, 4)).Select 'не работает

End With

End Sub