Ciao Anthony e ancora grazie, la modifica da te fatta è perfetta, tanto da far insorgere un altro problema, ovvero di allineamento tra i dati come scaricati dal sito. Mi spiego ; nel foglio "Riepilogo " in colonna 1 ho le specifiche dei titoli e a lato colonna 2 etc vengono aggiunti le colonne con i valori dei vari titoli, e fin qui tutto Ok , mi sono però accorto che le righe scaricate dal sito non si allineano perfettamente alla griglia di colonna 1.
Quindi mi sono ingegnato ( si fa per dire ) a trovare/assemblare una macro che riportasse in posizione le colonne però
ho osservato qualche inconveniente : ovvero l'istruzione che gestisce la ricerca non è puntuale , a volte sbaglia nel definire la colonna con gli over range , oltre a ciò ho notato che l'istruzione di spostamento mi lascia 2 o 3 righe a fondo colonna . dove sbaglio ?
- Codice: Seleziona tutto
Sub M_ordina_click()
Dim sh As Worksheet
Dim riga As Long
Dim colonna As Long
Dim differenza As Long
Set sh = ThisWorkbook.Sheets("Riepilogo")
Sheets("Riepilogo").Activate
sh.Cells.EntireColumn.AutoFit
With Cells.SpecialCells(xlCellTypeConstants).Areas
riga = .Item(.Count)(.Item(.Count).Count).Row
colonna = .Item(.Count)(.Item(.Count).Count).Column
valore = Cells(riga, colonna).Text
End With
differenza = (riga - 71) ' 71 è il valore standard delle righe ( se il sito non cambia impaginazione.
Cells(1, 12).Value = riga ' ultima cella andata "sotto" rispetto alle altre
Cells(1, 13).Value = colonna ' colonna interessata
Cells(1, 14).Value = differenza ' delta righe "sotto"
If (riga - 71) = 0 Then
MsgBox ("Tutto ok")
Exit Sub
ElseIf (riga - 71) > 0 Then
Range(Cells(2 + differenza, colonna), Cells(riga, colonna)).Copy Destination:=Cells(2, colonna)
Range(Cells(riga, colonna), Cells((riga + differenza), colonna)).Clear
MsgBox ("colonna pareggiata")
Range("L1:N1").Clear
End If
'Sheets("Riepilogo").Range("B1").Resize(100, 100).ClearContents '*** AZZERA Riepilogo
'Range("B1:z100").Sort Key1:=Range("B1"), Order1:=xlLeftToRight, _
'Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
'xlLeftToRight, DataOption1:=xlSortNormal
Set sh = Nothing
End Sub
dato che non ho ancora capito come aggiungere le immagini allego il file in toto.
http://www.filedropper.com/yahoo4a_1