Макросы в Excel

Sub ПримерИспользования_GetCell()
    ' вставляем значение в первую пустую ячейку столбца A
   ' (вставка производится ниже всех данных в первом столбце листа)
   GetCell("a").Value = Now

    ' то же самое, но с другими вариантами параметра функции (все 4 способа равнозначны)
   GetCell("a:a").Value = 111
    GetCell(Columns(1)).Value = 222
    GetCell([a:a]).Value = 333

    '  ============ вставка в первую незаполненную ячейку третьей строки =================
   GetCell(Destination:=3).Value = 1
    ' то же самое, но с другими вариантами параметра функции (все 4 способа равнозначны)
   GetCell("3").Value = 2
    GetCell(Rows(3)).Value = 3
    GetCell([3:3]).Value = 4

    '  ============ другие варианты использования =================
   GetCell().Value = "активная ячейка"    ' вставка в заданную ячейку (вызов без параметра)
   GetCell("NewSheet").Value = "на новый лист в ячейку A1"    ' создаётся новый лист
   GetCell("NewWorkbook").Value = "в новую книгу в ячейку A1"    ' создаётся новая книга Excel
End Sub

Function GetCell(Optional ByRef Destination As Variant) As Range
    ' Функция получает в качестве параметра ссылку на диапазон
   ' Возвращает ячейку для вставки данных в зависимости от параметра:
   '   если параметр не задан - возвращается активная ячейка текущей книги
   '   если параметр является ссылкой на ячейку - возвращается эта ячейка
   '   если параметр является ссылкой на строку - возвращается первая незаполненная ячейка этой строки
   '   если параметр является ссылкой на столбец - возвращается первая незаполненная ячейка этого столбца

    On Error Resume Next: Err.Clear
    If IsMissing(Destination) Then
        If ActiveWorkbook Is Nothing Then Workbooks.Add(xlWBATWorksheet).Worksheets(1).Name = "Данные"
        Set GetCell = ActiveCell: Exit Function
    End If

    If Not IsObject(Destination) Then If IsNumeric(Destination) Then Destination = Val(Destination)

    Select Case TypeName(Destination)
        Case "String"
            If Destination = "NewWorkbook" Then Workbooks.Add(xlWBATWorksheet).Worksheets(1).Name = "Данные"
            If ActiveWorkbook Is Nothing Then Workbooks.Add(xlWBATWorksheet).Worksheets(1).Name = "Данные"

            If Destination = "NewSheet" Then ActiveWorkbook.Worksheets.Add , ActiveSheet

            Set GetCell = Range(Destination)
            If Err.Number = 1004 Then
                If Destination Like String(Len(Destination), "[A-z]") Then _
                   Err.Clear: Set GetCell = Range(Destination & ":" & Destination)
                'Debug.Print Err.Number, Err.Description
               If Err Then Set GetCell = ActiveCell: Exit Function    ' неопознанная ошибка
           End If
        Case "Integer", "Long", "Double"
            If ActiveWorkbook Is Nothing Then Workbooks.Add(xlWBATWorksheet).Worksheets(1).Name = "Данные"
            Err.Clear: If Val(Destination) > 0 Then Set GetCell = Rows(Val(Destination))
            If Err Then Set GetCell = ActiveCell: Exit Function    ' неопознанная ошибка

        Case "Range": Set GetCell = Destination
        Case "Workbook": Set GetCell = Destination.Worksheets(1).[a:a]
        Case "Worksheet": Set GetCell = Destination.[a:a]

        Case Else
            Debug.Print "Another parameter type: ", TypeName(Destination)
            Set GetCell = ActiveCell: Exit Function    ' неопознанная ошибка
   End Select

    If GetCell Is Nothing Then Set GetCell = ActiveCell: Exit Function
    Select Case True
        Case GetCell.Address = GetCell.EntireColumn.Address
            Set GetCell = GetCell.Columns(1).Cells(GetCell.Rows.Count).End(xlUp).Offset(1)
        Case GetCell.Address = GetCell.EntireRow.Address
            Set GetCell = GetCell.Rows(1).Cells(GetCell.Columns.Count).End(xlToLeft).Offset(, 1)
        Case Else: Set GetCell = GetCell.Cells(1)

    End Select
End Function