Public Sub CercaVuoteSopra() 'trova le vuote nell'intervallo
Dim rngIn As Range

Set rngIn = Range(Range("A1"), Range("A1").End(xlDown)).Offset(, 3)
Dim rngVuota As Range
With rngIn
For i = 1 To rngIn.Cells.Count
  Set rngVuota = rngIn.Cells(i).Find(What:="", _
    SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not rngVuota Is Nothing Then
 rngVuota.Select
  If GetDomain(rngVuota.Offset(0, -1)) = GetDomain(rngVuota.Offset(-1, -1)) Then

    ActiveCell.Offset(-1, 0).Range("A1:C1").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveSheet.Paste
    
  End If: End If
  Next i
  End With
  Set rngIn = Nothing
  Set rngVuota = Nothing
End Sub
Public Sub CercaVuoteSotto() 'trova le vuote nell'intervallo
Dim rngIn As Range

Set rngIn = Range(Range("A1"), Range("A1").End(xlDown)).Offset(, 3)
Dim rngVuota As Range
With rngIn
For i = 1 To rngIn.Cells.Count
  Set rngVuota = rngIn.Cells(i).Find(What:="", _
    SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not rngVuota Is Nothing Then
 rngVuota.Select
  If GetDomain(rngVuota.Offset(0, -1)) = GetDomain(rngVuota.Offset(1, -1)) Then

    ActiveCell.Offset(1, 0).Range("A1:C1").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveCell.Offset(-1, 0).Range("A1").Select
    ActiveSheet.Paste
    
  End If: End If
  Next i
  End With
  Set rngIn = Nothing
  Set rngVuota = Nothing
End Sub

Private Function GetDomain(Stringa)
    Dim oRegExp As Object, strTemp As String
    Dim oMatches   As Object
    Set oRegExp = CreateObject("vbscript.RegExp")
    With oRegExp
        .IgnoreCase = False
        .Global = True
    End With
    oRegExp.Pattern = "^(?:[^/]+://)?([^/:]+/)"
    Set oMatches = oRegExp.Execute(Stringa)
    For Each oMatches In oMatches
        strTemp = strTemp & oMatches.Value
    Next
    Set oRegExp = Nothing
    GetDomain = strTemp
End Function