Copia l'intero codice e inseriscilo in un modulo
- Codice: Seleziona tutto
Public WAQ1 As Worksheet, WAQ2 As Worksheet
Sub AggiornaWeb()
Application.ScreenUpdating = False
Application.Calculation = xlManual
Set WAQ1 = ThisWorkbook.Sheets("Foglio1") '<<<<< assegna il nome effettivo del foglio con la queryweb
Set WAQ2 = ThisWorkbook.Sheets("Foglio2") '<<<<< assegna il nome effettivo del foglio dati finale
WAQ1.Select
WAQ1.Cells.Clear
Range("A1").Select
With ActiveSheet.QueryTables.Add(Connection:="URL;http://it.zulubet.com", _
Destination:=Range("$A$1"))
.Name = "it.zulubet"
.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
RiportaProno
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Private Sub RiportaProno()
WAQ2.Cells.Clear
WAQ1.Rows("1:2").Copy Destination:=WAQ2.Range("A1")
UR1 = WAQ1.Range("A" & Rows.Count).End(xlUp).Row
For RR1 = 3 To UR1
If WAQ1.Range("F" & RR1).Value = 1 Then '<<<<< condizione che copia se il pronostico corrisponde a "1"
UR2 = WAQ2.Range("F" & Rows.Count).End(xlUp).Row + 1
WAQ1.Rows(RR1).Copy Destination:=WAQ2.Range("A" & UR2)
End If
Next RR1
WAQ2.Select
WAQ2.Columns("A:K").EntireColumn.AutoFit
End Sub
I fogli considerati sono "Foglio1" e "Foglio2"
se non sono questi i nomi modifica questi nomi nella macro di avvio dove indicato con <<<<
Dopodiché avvia "AggiornaWeb"
ciao