Sub zapolnenie()
    Dim intKeys, i As Integer
    Dim rowRange As Range
    Dim LastRow As Long
    Dim strKeyPath, strComputer, arrSubKeys()
    
    ' Скрипт по сбору информации об установленном ПО
    ' информация берется например из ветки реестра
    ' SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18
    ' далее (по идее) должно записывться в этот же файл экселя - для каждого IP - свои данные
    Const HKEY_LOCAL_MACHINE& = &H80000002
    Const ForWriting = 2
    Const ForAppending = 8
    
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    Set rowRange = Range("A3:A" & LastRow)
    strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Products"  ' ветка реестра сокращена
   
    For Each cell In rowRange
        strComputer = cell.Value     ' по идее должно браться значение IP из первой строки диапазона строк и далее по циклу Next rrow (? наверно ?)
'        strComputer = "." 'strComputer = "172.16.100.101"
        ' указываем что oReg будет лезть в реестр
        Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
        ' Указываем куда именно в реестре мы полезем
        oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
        ' Перебор неких subkey в массиве arrSubKeys, на самом деле шаримся по подразделам Installer
        
        strValueName = "ProductID"
        For Each subkey In arrSubKeys
            strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\" & subkey ' ветка реестра сокращена
            'Ищем в подразделах строковой параметр "DisplayName"
            oReg.GetExpandedStringValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, strValue
            If strValue <> Empty Then
                cell.Offset(, 4).Value = strValue
            Else
                i = 1
            End If
        Next
        
        strValueName = "DisplayVersion"
        For Each subkey In arrSubKeys
            strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\" & subkey ' ветка реестра сокращена
            'Ищем в подразделах строковой параметр "DisplayName"
            oReg.GetExpandedStringValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, strValue
            If strValue <> Empty Then
                cell.Offset(, 2).Value = strValue
            Else
                i = 1
            End If
        Next
        
        strValueName = "InstallDate"
        For Each subkey In arrSubKeys
            strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\" & subkey ' ветка реестра сокращена
            'Ищем в подразделах строковой параметр "DisplayName"
             oReg.GetExpandedStringValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, strValue
            If strValue <> Empty Then
                cell.Offset(, 3).Value = strValue
            Else
                i = 1
            End If
        Next
    Next cell
End Sub

Sub regUpload ()
Dim intKeys, i As Integer, strKeys As Variant
Dim rowRange As Range
Dim LastRow As Long
Dim LastCol As Long
' Скрипт по сбору информации об установленном ПО
' информация берется из ветки реестра
' HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall
' данные записываются в соответствующие ячейки
 Const HKEY_LOCAL_MACHINE = &H80000002
LastRow = Cells(rows.Count, "A").End(xlUp).Row
Set rowRange = Range("A3:A" & LastRow) ‘чтение списка IP начинается с A3
LastCol = Cells(LastRow, 5).Column ‘для определения диапазона таблицы указываем ячейку нижней правой области, т.е. «последняя определенная строка + последний столбец
Set colRange = Range(Cells(1, 1), Cells(LastRow, 1)) 
 For Each cell In rowRange ‘ здесь начинается основной цикл
strComputer = cell.Value ‘переменной присваивается значение ячейки из списка
Const ForWriting = 2
Const ForAppending = 8
Set objWsNet = CreateObject("WScript.Network")
Computer = objWsNet.ComputerName
User = objWsNet.UserName
 ' указываем что oReg будет лезть в реестр
Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
 ' Указываем куда именно в реестре мы полезем
strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall" ‘ в данном примере ветка реестра сокращена – нужно вставить свою, которая интересует
oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
' Перебор неких subkey в массиве arrSubKeys,
' на самом деле шаримся по подразделам Uninstall`а
For Each SubKey In arrSubKeys
         strKeyPath = " SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\" & SubKey ‘ в конце слэш очень важен
        'Ищем в подразделах строковой параметр " ProductID " – выбран в качестве примера, вместо него можно вставить свой интересующий параметр в данной ветке реестра
        strValueName = "" ‘очищаем переменную
        strValueName = "ProductID"
        oReg.GetExpandedStringValue HKEY_LOCAL_MACHINE, strKeyPath, _
        strValueName, strValue
        If strValue <> Empty Then
        cell.Offset(, 4).Value = strValue ‘записываем в 4 столбец текущей строки
        Else
        i = 1
        End If
Next
 For Each SubKey In arrSubKeys
 ‘ далее еще два аналогичных цикла для двух других параметров текущей ветки реестра
        strKeyPath = " SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\" & SubKey
        'Ищем в подразделах строковой параметр " DisplayVersion "
        strValueName = ""
        strValueName = "DisplayVersion"
         oReg.GetExpandedStringValue HKEY_LOCAL_MACHINE, strKeyPath, _
        strValueName, strValue
        If strValue <> Empty Then
        cell.Offset(, 3).Value = strValue
        Else
        i = 1
        End If
Next
 For Each SubKey In arrSubKeys
        strKeyPath = " SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\" & SubKey
        'Ищем в подразделах строковой параметр " InstallDate "
        strValueName = ""
         strValueName = "InstallDate"
         oReg.GetExpandedStringValue HKEY_LOCAL_MACHINE, strKeyPath, _
        strValueName, strValue
        If strValue <> Empty Then
        cell.Offset(, 2).Value = strValue
        Else
        i = 1
        End If
Next
 Next cell ‘ закрываем основной цикл
 
End Sub

Sub regcrypto()
Dim intKeys, i As Integer, strKeys As Variant
Dim rowRange As Range
Dim LastRow As Long
Dim LastCol As Long
' Скрипт по сбору информации об установленном ПО
 
Const HKEY_LOCAL_MACHINE = &H80000002
LastRow = Cells(rows.Count, "A").End(xlUp).Row
Set rowRange = Range("A3:A" & LastRow)
LastCol = Cells(LastRow, 8).Column
Set colRange = Range(Cells(1, 1), Cells(LastRow, 7))
Arr_strValueName = Array("ProductID", "DisplayVersion", "InstallDate")

For Each cell In rowRange 'начало основного цикла

If Not Ping(strComputer) Then
cell.Offset(, 6).Value = 0
Else:
strComputer = cell.Value
Const ForWriting = 2
Const ForAppending = 8
Set objWsNet = CreateObject("WScript.Network")
Computer = objWsNet.ComputerName
User = objWsNet.UserName
cell.Offset(, 5).Value = 1

' указываем что oReg будет лезть в реестр
Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
 
' Указываем куда именно в реестре мы полезем
strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer" ' реальная ветка убрана для примера
oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
' Перебор неких subkey в массиве arrSubKeys,

For Each SubKey In arrSubKeys
        strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\" & SubKey ' реальная ветка убрана для примера
j = 5
For Each strValueName In Arr_strValueName
j = j - 1
        oReg.GetExpandedStringValue HKEY_LOCAL_MACHINE, strKeyPath, _
        strValueName, strValue
        If strValue <> Empty Then
        cell.Offset(, j).Value = strValue
        Else
        End If
Next
'End If

Next cell

End Sub