Работа с ячейками

ActiveCell.Address

Sheets(1).Activate

debug.print ActiveCell.Address

Sub GetActiveRange_fromXML()
    Dim xmlDoc As Object, xmlRoot As Object, xmlRNode As Object
    Dim xmlPane_Node As Object, xmlPanes_Node As Object, xmlWsOpt_Node As Object, xmlWs_Node As Object, xmlWb_Node As Object
    Dim sSelAddr As String, lR As Long, lC As Long
    Dim avTmp(), avRes(), lCnt As Long
    Dim sFileName As String, sNewFileName As String, sExtens As String
    
    sFileName = ThisWorkbook.Path & "\Книга1.xls"
    sExtens = Mid(sFileName, InStrRev(sFileName, "."))
    sNewFileName = Replace(sFileName, sExtens, ".xml")
    Workbooks.Open sFileName
    ActiveWorkbook.SaveAs sNewFileName, xlXMLSpreadsheet
    ActiveWorkbook.Close 0
    Set xmlDoc = CreateObject("Microsoft.xmldom")
    xmlDoc.async = False
    If Not xmlDoc.Load(sNewFileName) Then
        MsgBox "Возникла ошибка при загрузке файла. Возможно, файл испорчен."
        Exit Sub
    End If
    'по общим сведениям документа
    For Each xmlRNode In xmlDoc.ChildNodes
       If xmlRNode.BaseName = "Workbook" Then
            'по книге
            For Each xmlWb_Node In xmlRNode.ChildNodes
                If xmlWb_Node.BaseName = "Worksheet" Then
                    lCnt = lCnt + 1
                    ReDim avTmp(0 To 3)
                    avTmp(0) = "Лист №" & lCnt 'номер листа
                    lR = 1: lC = 1: sSelAddr = ""
                    'по листу
                    For Each xmlWs_Node In xmlWb_Node.ChildNodes
                        If xmlWs_Node.BaseName = "WorksheetOptions" Then
                            'по настройкам листа
                            For Each xmlWsOpt_Node In xmlWs_Node.ChildNodes
                                If xmlWsOpt_Node.BaseName = "Panes" Then
                                    'по областям листа
                                    For Each xmlPanes_Node In xmlWsOpt_Node.ChildNodes
                                        If xmlPanes_Node.BaseName = "Pane" Then
                                            'по области выделения
                                            For Each xmlPane_Node In xmlPanes_Node.ChildNodes
                                                If xmlPane_Node.BaseName = "ActiveRow" Then
                                                    lR = Val(xmlPane_Node.nodeTypedValue) + 1
                                                End If
                                                If xmlPane_Node.BaseName = "ActiveCol" Then
                                                    lC = Val(xmlPane_Node.nodeTypedValue) + 1
                                                End If
                                                If xmlPane_Node.BaseName = "RangeSelection" Then
                                                    sSelAddr = xmlPane_Node.nodeTypedValue
                                                End If
                                            Next xmlPane_Node
                                        End If
                                    Next xmlPanes_Node
                                End If
                            Next xmlWsOpt_Node
                        End If
                    Next xmlWs_Node
                    If sSelAddr = "" Then sSelAddr = Cells(lR, lC).Address(, , xlR1C1)
                    avTmp(1) = lR: avTmp(2) = lC: avTmp(3) = sSelAddr
                    ReDim Preserve avRes(lCnt - 1)
                    avRes(lCnt - 1) = avTmp
                End If
            Next xmlWb_Node
        End If
    Next
 
    If lCnt Then
        Cells(1, 1).Resize(, UBound(avTmp) + 1).Value = Array("Номер листа", "Строка", "Столбец", "Адрес выделения")
        For lR = LBound(avRes) To UBound(avRes)
            Cells(lR + 2, 1).Resize(, UBound(avTmp) + 1).Value = avRes(lR)
        Next lR
    End If
End Sub

    s = Dir(excelFolder & "sheet*.xml")
    Do
            sheetXML = "Лист " & Left(s, Len(s) - 4) & " - активна ячейка "
            n = FreeFile
            Open excelFolder & s For Input As #n
            Input #n, t
            Input #n, t
            k = InStr(t, xmlActiveCellParam)
            If k Then
                cellAddr = Mid(t, k + Len(xmlActiveCellParam))
                cellAddr = Left(cellAddr, InStr(cellAddr, """") - 1)
                Debug.Print sheetXML & cellAddr
            Else
                Debug.Print sheetXML & "A1"
            End If
            Close #n
        s = Dir
    Loop Until s = ""