Sub name()
Dim vItem, avArr, li, a As Long
ReDim avArr(1 To 1, 1 To Columns.Count)
With New Collection
On Error Resume Next
For Each vItem In Range("G2", Cells(Rows.Count,7).End(xlUp)).Value
.Add vItem, CStr(vItem)
If Err = 0 Then
li = li + 1:
avArr(1, (li - 1) + i) = vItem
Else: Err.Clear
End If
Next
End With
If li Then
Worksheets("l4").[B1].Resize(1, li).Value = avArr
a = Worksheets("l4").Cells.Find(What := "*", SearchOrder := xlByColumns, SearchDirection := xlPrevious).Column
End If
End Sub

Dim rF As Range
    Dim lLastRow As Long, lLastCol As Long
    'ищем последнюю ячейку на листе, в которой хранится хоть какое-то значение
    Set rF = ActiveSheet.UsedRange.Find("*", , xlValues, xlWhole, xlPrevious)
    If Not rF Is Nothing Then
        lLastRow = rF.Row    'последняя заполненная строка
        lLastCol = rF.Column 'последний заполненный столбец
        MsgBox rF.Address 'показываем сообщение с адресом последней ячейки
    Else
        'если ничего не нашлось - значит лист пустой
        'и можно назначить в качестве последних первую строку и столбец
        lLastRow = 1
        lLastCol = 1
    End If

Sub FullDate()
Dim vItem, avArr, li As Long
ReDim avArr (1 To Rows.Count, 1 to 1)
With New Collection
On Error Resume Next
For Each vItem In Range("B2", Cells(Rows.Count,2).End(xlUp)).Value
.Add vItem, CStr(vItem)
if Err = 0 Then
li = li + 1: avArr(li, 1)= vItem
else: Err.Clear
End If
Next
End With

If li Then Worksheets("l3").[c1].Resize(li).value = avArr
end sub