"SELECT * FROM `'1$'`, `'2$'`"

Sheets("2").Range("A1").Select

            With .Sort
            .SortFields.Add Key:=Range(Cells(1, 4), Cells(1, Application.WorksheetFunction.Match("Âñã", Range("D1:AX1"), False))), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SetRange Range(Cells(1, 4), Cells(Cells(Rows.Count, 2).End(xlUp).Row, Application.WorksheetFunction.Match("Âñã", Range("D1:AX1"), False)))
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlLeftToRight
            .SortMethod = xlPinYin
            .Apply
            End With

SELECT 'Лист$'.*

Sub AddMenu()
  Dim objCmdBrBtn As CommandBarButton
    Set objCmdBrBtn = CommandBars("Cell").Controls.Add(msoControlButton, , , , True)
    With objCmdBrBtn
    .Caption = "New Menu"
    .Enabled = True
    .OnAction = "Test"
    .Visible = True
    .FaceId = 10
  End With
End Sub

Sub Test()
Msgbox "Test"
End Sub

Sub test2()
Dim a(), cell As Range, i%
[f:g].ClearContents
ReDim a(1 To [a1:a15].Count, 1 To 2): i = 1
For Each cell In [a1:a15]
a(i, 1) = cell.Value
a(i, 2) = cell.Offset(, 3).Value
i = i + 1
Next
[f1].Resize(UBound(a)) = a
End Sub

Sub test1()
Dim dict As Object, cell As Range
Set dict = CreateObject("scripting.dictionary")
For Each cell In [a1:a15]
dict.Add cell.Value, Day(cell) & "|" & WeekdayName(Weekday(cell), True) & "|" & cell.Offset(, 1).Value
Next
[d1].Resize(, UBound(dict.items)) = dict.items
End Sub

Sub test27()
Dim strConn$, strSQL$, rs As Object, cn As Object, QTable As QueryTable, objPivotCache As Object
Set rs = CreateObject("ADODB.Recordset"): Set cn = CreateObject("ADODB.Connection")
Sheets("12").[A1].CurrentRegion.ClearContents
Sheets("Data").Activate
strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Mode=Read;Data Source=" & ThisWorkbook.FullName
strConn = strConn & ";Extended Properties=""Excel 12.0;HDR=true"";"
strSQL = "Select colPIB,colRegistrationTime, colProf From [Data$] As t1 Inner Join [ar$] As t2 On (t1.colTabNumber=t2.colTabNumber)"
cn.Open strConn
rs.Open strSQL, cn
'Set QTable = Sheets("12").QueryTables.Add(rs, Sheets("12").Range("A1")): QTable.Name = "Temp"
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rs, Version:=xlPivotTableVersion14).CreatePivotTable _
    TableDestination:=Sheets("12").[a3], TableName:="sd", DefaultVersion:=xlPivotTableVersion14
    With ActiveSheet.PivotTables("sd")
    With .PivotFields("colPIB")
        .Orientation = xlRowField
        .Position = 1
    End With
    With .PivotFields("colRegistrationTime")
        .Orientation = xlRowField
        .Position = 2
    End With
    With .PivotFields("colProf")
        .Orientation = xlPageField
        .Position = 1
    End With
    End With
'QTable.Refresh
rs.Close:  cn.Close
Set cn = Nothing: Set rs = Nothing
ActiveWorkbook.Sheets("12").Activate
End Sub

ss = Application.WorksheetFunction.Index(Sheets("Data").Range("A1").CurrentRegion, Application.WorksheetFunction.Match(s, Sheets("Data").Range("C:C"), 0), 1)

Sub test1()
Dim i%, s$
With CreateObject("scripting.dictionary")
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If Not .exists(CStr(Cells(i, 3))) Then .Add (CStr(Cells(i, 3))), 1
Next
's = Join(.keys, ";")
's = "{" & s & "}"
Names.Add Name:="test", RefersTo:=.keys
End With
's = ThisWorkbook.Names("test").RefersTo
'Debug.Print s
End Sub

Sub t1()
Dim a()
a = [a1].CurrentRegion.Value
[g1].Resize(UBound(a, 1), UBound(a, 2)) = a
End Sub

 Private Declare Function ActivateKeyboardLayout Lib "user32" (ByVal HKL As Long, ByVal flags As Long) As Long
 

 #If Win64 Then Private Declare PtrSafe Function ActivateKeyboardLayout Lib "user32" (ByVal HKL As LongLong, ByVal flags As LongLong) As LongLong #Else Private Declare Function ActivateKeyboardLayout Lib "user32" (ByVal HKL As Long, ByVal flags As Long) As Long #End If

Sub ImportXMLSchema()
    Dim xmMap As XmlMap, strXPath As String
    Application.DisplayAlerts = False
    Set xmMap = ActiveWorkbook.XmlMaps.Add("D:\Мои документы\Вересень 2014\22.09.2014 ГУ46 22090343.xml", "egu46")
    Application.DisplayAlerts = True
    xmMap.AdjustColumnWidth = False
    xmMap.PreserveNumberFormatting = True
strXPath = "wagon_num"
ActiveSheet.[a1].XPath.SetValue xmMap, strXPath ' Строка не работает
    Set xmMap = Nothing
End Sub
 

CreateObject("wscript.shell").Run """C:\Program Files\ABBYY FineReader 11\FineReader.exe "" & answer """
 

=SUM(IF(OFFSET(B2:B4;0;2)="монтер";1;0))
 

Sub er()
Dim f$
Application.CutCopyMode = False
f = "c:\Documents and Settings\vvv\Рабочий стол\20245.pdf"
CreateObject("wscript.shell").Run """" & f & """"
Application.Wait (Now + TimeValue("0:00:05"))
SendKeys "^a", 100
SendKeys "^c", 10
SendKeys ("%n"), 10
Workbooks("по пдф").ActiveSheet.[a1].Activate
' ActiveSheet.[a1].PasteSpecial
End Sub
 

 ReDim arrQ(1 To 243, 1 To 13)
r = 1
For i = LBound(arrX) To UBound(arrX)
 For Each ws In ActiveWorkbook.Sheets
    If ws.Name = arrX(i) Then
    lr = ws.Cells(400, 6).End(xlUp).Row
        If lr > 4 Then' отбрасываем название таблиц
          For q = 5 To lr Step 1
          arrQ(r) = ws.Rows(q).Value
          
'          lr2 = Sheets(e).Cells(400, 6).End(xlUp).Row
'          ws.Rows(q).Copy Destination:=Sheets(e).Rows(lr2 + 1)
'          Sheets(e).Cells(lr2 + 1, 15).Value = ws.Name
          r = r + 1
          Next
        End If
        End If
 Next
Next
ActiveSheet.[b7].Resize(UBound(arr), UBound(arrQ, 2)).Value = arrQ
Application.ScreenUpdating = True
[b7].Activate 

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ArrX, q%, i%, lr%
If Target.Cells.Count > 1 Then Exit Sub
'On Error Resume Next
i = 0
lr = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
If Not Intersect(Target, Range("F5:F250")) Is Nothing Then
ArrX = Worksheets("Îðåíä. âàã.").[a1].CurrentRegion
For q = LBound(ArrX) To UBound(ArrX)
If Target = ArrX(q, 1) Then
Target.Offset(0, 1).Value = ArrX(q, 2)
Target.Offset(0, -1).Value = ArrX(q, 3)
Target.Offset(0, -2).Value = ArrX(q, 4)
Target.Offset(0, -3).Value = ArrX(q, 5)
i = 1
End If
Next
Range(Cells(Target.Row, 2), Cells(Target.Row, 13)).Font.Color = vbGreen
If IsEmpty(Cells(Target.Row, 2)) Then Cells(Target.Row, 2).Value = Cells(lr, 2).Value + 1
End If
End Sub
 

 Sub ee()
 Dim r As Integer, q As Integer
 Dim a()
 a = Array("A", "2M62 0393 Á", "2", "D")
 [a1].ClearContents
 For r = 0 To 2 Step 1
 If ActiveSheet.Name = a(r) Then
 [a1].Value = 10
 End If
 Next r
 End Sub