Option Explicit

Public Function GetDiskInfo() As String
    Dim pWMI As Object, pDisks As Object, pDisk As Object
    Dim res As String, s As String
     
    Set pWMI = GetObject("winmgmts:\\")
    If pWMI Is Nothing Then Exit Function
    Set pDisks = pWMI.ExecQuery("Select * from Win32_DiskDrive Where BytesPerSector Is Not Null", , 48)
    If pDisks Is Nothing Then Exit Function
    For Each pDisk In pDisks
        s = TrimAll(pDisk.SerialNumber & "")
        If Len(s) Then res = res & "-" & s
    Next
    GetDiskInfo = Mid(res, 2)
End Function
Function TrimAll(ByVal s As String)
    s = Replace(s, vbCrLf, " ")
    s = Replace(s, vbLf, " ")
    s = Replace(s, Chr(10), " ")
    s = Replace(s, vbNewLine, " ")
    s = Replace(s, vbTab, " ")
    s = Replace(s, " ", "")
    TrimAll = s
End Function

Public Function GetDiskInfo()
    Dim pWMI As Object, pDisks As Object, pDisk As Object
    Dim res As String, s As String
     
    Set pWMI = GetObject("winmgmts:\\")
    Set pDisks = pWMI.ExecQuery("Select * from Win32_DiskDrive Where BytesPerSector Is Not Null", , 48)
     
    For Each pDisk In pDisks
        s = TrimAll(pDisk.SerialNumber)
        If Len(s) Then res = res & "-" & s
    Next
    GetDiskInfo = Mid(res, 2)
End Function

  For Each cell In Target   
       If Not Intersect(cell, Range("c2:c100")) Is Nothing Then  
            With cell.Offset(0, -1)        
            If IsEmpty(Target) Then
     Target(1, 2) = Empty
Else
     With Target(1, 2)
        .Value = Now
        End With
End If
    Next cell
End Sub

    'Create HTMLFile Object
    Set HTML_Content = CreateObject("htmlfile")
 

'Copy data from site
'===============================================================================================================

    Dim htm As Object
    Dim Tr As Object
    Dim Td As Object
    Dim Tab1 As Object
    Dim Web_URL As String
    Dim HTML_Content As Object
    Dim Column_Num_To_Start As Integer
    Dim iRow As Integer
    Dim iCol As Integer
    Dim iTable As Integer
    
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.ScreenUpdating = False
ThisWorkbook.Worksheets("Àíàëèç").Select

'ActiveSheet.Range("A2:AO65000").ClearContents

 
    'Replace the URL of the webpage that you want to download
    Web_URL = VBA.Trim(ThisWorkbook.Worksheets("Áàçà").Cells(Àíàëèç1, col))
 
    'Create HTMLFile Object
    Set HTML_Content = CreateObject("htmlfile")
 
    'Get the WebPage Content to HTMLFile Object
    With CreateObject("msxml2.xmlhttp")
        .Open "GET", Web_URL, False
        .send
        HTML_Content.Body.Innerhtml = .responseText
    End With

подскажите а куда вставлять этот код2
#If Win64 Then
  Declare PtrSafe Function GetSystemMenu Lib "user32" (ByVal hwnd As LongPtr, ByVal bRevert As Long) As LongPtr 
  Declare PtrSafe Function RemoveMenu Lib "user32" (ByVal hMenu As LongPtr, ByVal nPosition As Long, ByVal wFlags As Long) As Long
  Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
#Else 
  Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long 
  Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
  Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long 
#End If