Importar tabla de una Web

Efectivamente como comenta el usuario anterior no está en formato tabla pero podemos obtenerla con una macro.

Cuando capturas esta hoja se te colocan más celdas de las necesarias, por eso tendrás que borrar todo lo innecesario antes. Luego en la macro ajusta el nro de fila inicial. Por ahora la dejé en 28 que es como la obtuve sin hacer el borrado.

Sub transponerTablaWeb()
'x Elsamatilde
'inicio del rango: fila 28 (ajustar)
orig = 28: desti = 28
'se recorre la col A desde fila 28 hasta la última con datos
finx = Range("A" & Rows.Count).End(xlUp).Row
'se repite el bucle cada 10 celdas
For i = orig To finx Step 10
    'se copia el rango de 10 celdas pegando transpuesto a partir de col C
    Range("A" & i & ":A" & i + 9).Copy
    Range("C" & desti).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    'se incrementan las filas de cada col
   desti = desti + 1
Next i
End Sub

Entra al Editor de macros (con ALT + F11)

Inserta un módulo y allí copia el código.

Podrás ejecutarlo desde el mismo Editor o desde la hoja, menú Desarrollador, Macros. Podrás utilizar otras opciones de cómo ejecutar macros que las tengo explicadas en mi sitio web que dejo al pie.

.

:)

Esa página es ineficiente y -encima- no te brinda la info en un formato de tabla "real". Por ello vas a tener que resolver el tema con "cirugía mayor" (una macro) como la que adjunto:

Sub extrae_Datos()
Dim xml, HtmlDoc, mZI, mDiv, iDiv, ws As Worksheet
Dim Url, Dic, i&, j%, C As Range
Application.ScreenUpdating = False
Url = "http://asobal.es/equipos_estadisticas_equipo.php"
Set xml = CreateObject("Microsoft.XMLHttp")
xml.Open "Get", Url, False   'petición sincrónica
xml.Send
Set HtmlDoc = CreateObject("HTMLFile")
HtmlDoc.body.innerHTML = caracteres_Especiales(xml.responseBody)
Set mZI = HtmlDoc.getElementByID("zona_izquierda")
Set mDiv = mZI.getElementsByTagName("div")
Set Dic = CreateObject("Scripting.Dictionary")
i = 0
For Each iDiv In mDiv
  i = 1 + i
  Set Dic(i) = iDiv
Next
Set ws = Workbooks.Add.Sheets(1)
ws.[a1] = "JUGADORES DE CAMPO"
i = 1
Do
  If i >= Dic.Count Then Exit Do
  Do Until Dic(i).ID = "fila_1_listado_jugadores" And Trim(Dic(i).innerText) <> ""
    i = 1 + i
    DoEvents
  Loop
  Set C = ws.Cells(Rows.Count, "a").End(xlUp)
  C.Cells(2, 1) = Dic(i).innerText
  j = 0
  Do Until j = 9
    i = 1 + i
    Do Until Dic(i).ID = "cabecera_listado_jugadores" And Trim(Dic(i).innerText) <> ""
      i = 1 + i
      DoEvents
    Loop
    j = 1 + j
    C.Cells(2, 1 + j) = Dic(i).innerText
  Loop
  i = 1 + i
  DoEvents
Loop
With ws.[a1].CurrentRegion
  .Columns("g:j").NumberFormat = "0;;""---"""
  .Columns.AutoFit
  With .Rows(1)
    .HorizontalAlignment = xlCenterAcrossSelection
    .Font.Size = 14
    .Offset(1).Insert
  End With
End With
Set C = ws.Columns(2).Find("L 9M", After:=ws.[b5], LookIn:=xlValues, LookAt:=xlWhole).Offset(, -1)
C.EntireRow.Insert
C.EntireRow.Insert
With C.CurrentRegion
  C(1).Offset(-1) = "ARQUEROS"
  With .Rows(1).Offset(-1)
    .HorizontalAlignment = xlCenterAcrossSelection
    .Font.Size = 14
    .Offset(1).Insert
  End With
End With
With ws.ListObjects.Add(xlSrcRange, ws.[a3].CurrentRegion, , xlYes)
  .TableStyle = "TableStyleMedium15"
  .Range.AutoFilter
End With
With ws.ListObjects.Add(xlSrcRange, C.CurrentRegion, , xlYes)
  .TableStyle = "TableStyleMedium15"
  .Range.AutoFilter
End With
Application.ScreenUpdating = True
End Sub
Private Function caracteres_Especiales(mTxt) As String
With CreateObject("ADODB.Stream")
    .Type = 1 ' adTypeBinary
    .Open
    .Write mTxt
    .Position = 0
    .Type = 2 ' adTypeText
    .Charset = "iso-8859-1"
    caracteres_Especiales = .ReadText
End With
End Function

Espero te sea de utilidad, Mario (Cacho) Rodríguez.

:)

.

Gracias Mario, también quiero hacer lo mismo pero de este enlace, http://asobal.es/equipos_estadisticas.php?id=1