ALGUIEN SABE HACER ESTO MEJOR Y MÁS RESUMIDO. MI OBJETIVO ES APRENDER

Un saludo. Utilizo excel 2007. Este código hace exactamente lo que yo
quiero, pero seguro que se puede mejorar y me gustaría ver si alguien
pudiera enseñarme. Lo hago paso a paso para no equivocarme.

Gracias

Dim hoja As Worksheet



Public Sub Macro1()
'
' Macro1 Macro
'

'


datos = Array(119, 122, 125, 126, 127, 128, 129, 130, 131, 133, 134, 135,
136, 137, _
138, 139, 140, 141, 142, 143, 144, 145, 146, 147, 148, 149)

x = 1
For Each jose In datos
With Sheets("hoja1").QueryTables.Add(Connection:= _
"URL;http://www.futbolcracks.com/consult...amp="
& jose & "", _
Destination:=Sheets("hoja1").Range("$A$" & (x * 50) - 49 & ""))
.Name = "equipo" & jose
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "3"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

x = x + 1
Next


End Sub

Sub borrar_tablas()

For Each datos In Sheets("hoja1").QueryTables

datos.Delete

Next

End Sub

Sub borrar_filas_sobran()

Sheets("hoja1").Range("d:k").EntireColumn.Delete

End Sub

Sub ajustar_fila_A()

Sheets("hoja1").Range("a:a").ColumnWidth = 5

End Sub

Sub poner_categoria_equipo()

ultfila = Sheets("hoja1").Range("b5000").End(xlUp).Row


datos = Array(119, 122, 125, 126, 127, 128, 129, 130, 131, 133, 134, 135,
136, 137, _
138, 139, 140, 141, 142, 143, 144, 145, 146, 147, 148, 149)

x = 0
For fila = 3 To ultfila Step 50

Sheets("hoja1").Range("e" & fila) = datos(x)
Sheets("hoja1").Range("d" & fila & ":d" & Range("c" &
fila).End(xlDown).Row).Formula = "=+VLOOKUP($E$" & fila & ",equipos,2)"
Sheets("hoja1").Range("d" & fila & ":d" & Range("c" &
fila).End(xlDown).Row).Copy
Sheets("hoja1").Range("d" & fila).PasteSpecial xlPasteValues

Application.CutCopyMode = False



x = x + 1
Next

End Sub


Sub borrar_fila_sobrante()

Sheets("hoja1").Range("e:e").EntireColumn.Delete

End Sub

Sub copiar_datos_hoja_resumen()

Set hoja = Sheets("resumen")

ultfila = Range("b5000").End(xlUp).Row

For fila = 1 To ultfila Step 50

Sheets("hoja1").Range("a" & fila).CurrentRegion.Copy
hoja.Range("a" & hoja.Range("a10000").End(xlUp).Row + 1).PasteSpecial
xlPasteValues

Next

Set hoja = Nothing

End Sub

Sub borrar_filas_vacias()

Set hoja = Sheets("resumen")

ultfila = hoja.Range("b5000").End(xlUp).Row

For fila = ultfila To 1 Step -1

If IsEmpty(hoja.Range("b" & fila)) = True Then hoja.Range("b" &
fila).EntireRow.Delete
If hoja.Range("b" & fila) = "Equipo" Then hoja.Range("b" &
fila).EntireRow.Delete

Next

Set hoja = Nothing


End Sub


Sub insertar_fila()


Set hoja = Sheets("resumen")

hoja.Rows("1:1").Insert

Set hoja = Nothing

End Sub

Sub insertar_encabezado()

Set hoja = Sheets("resumen")

hoja.Range("a1:d1") = Array("ORDEN", "EQUIPO", "PUNTOS", "CATEGORIA")

hoja.Range("a1").CurrentRegion.Columns.AutoFit

Set hoja = Nothing

End Sub
Sub Hacer_tabla()

Sheets("resumen").Select

Set hoja = Sheets("resumen")

hoja.ListObjects.Add(xlSrcRange, hoja.Range("a1").CurrentRegion, ,
xlYes).Name = _
"Tabla1"
Range("Tabla1[#All]").Select
hoja.ListObjects("Tabla1").TableStyle = "TableStyleLight14"
Range("Tabla1[[#Headers],[ORDEN]]").Select


Set hoja = Nothing


End Sub

Sub Quitar_de_Lista()

Set hoja = Sheets("resumen")

Dim n As Byte
With hoja
For n = 1 To .ListObjects.Count
.ListObjects(1).Unlist
Next
End With

Set hoja = Nothing

End Sub

Sub numerar_equipos()

Set hoja = Sheets("resumen")

hoja.Range("a2") = 1

ultfila = hoja.Range("b5000").End(xlUp).Row

hoja.Range("a3:a" & ultfila).Formula = "=+(1+a2)"

hoja.Range("a2:a" & ultfila).Copy
hoja.Range("a2").PasteSpecial xlPasteValues

hoja.Range("a1").Activate



Set hoja = Nothing

End Sub


Sub procedimiento()

Application.CutCopyMode = False
Application.ScreenUpdating = False

Sheets("hoja1").Range("a1:g10000").Clear
Sheets("resumen").Range("a1").CurrentRegion.Clear




Call Macro1
Call borrar_tablas
Call borrar_filas_sobran
Call ajustar_fila_A
Call poner_categoria_equipo
Call borrar_fila_sobrante
Call copiar_datos_hoja_resumen
Call borrar_filas_vacias
Call insertar_fila
Call insertar_encabezado
Call Hacer_tabla
Call Quitar_de_Lista
Call numerar_equipos

Application.CutCopyMode = False

Application.ScreenUpdating = True

End Sub