Ecriture lors du fonctionnement d'un code

Le 17/11/2015 à 11:04

Bonjour,

J'aimerais savoir comment faire dans mon code, pour que celle-ci écrit dans les cellules A les chiffres de mes boucles I/J/2014 afin de pouvoir de préciser ma récupération de données.

Sub Macro1()
'
' Macro1 Macro
'

'
    Range("B2").Select
    ActiveCell.FormulaR1C1 = ""
    Range("B3").Select
    For j = 0 To 11
    For i = 1 To 31
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.meteociel.fr/temps-reel/obs_villes.php?code2=7005&jour2=" & i & "&mois2=" & j & "&annee2=2014" _
        , Destination:=Range("B" & Rows.Count).End(xlUp).Offset(1, 0))
        .Name = "obs_villes.php?code2=7005&jour2=3&mois2=3&annee2=2015"
        .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 = "10"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With

Next

Next

    Columns("C:E").Select
    Selection.Delete Shift:=xlToLeft
    Columns("D:J").Select
    Selection.Delete Shift:=xlToLeft

End Sub

Merci par avance,

11recuperation-de-donnees.xlsm (148.78 Ko)

Le 17/11/2015 à 11:36

Bonjour,

ceci te convient ?

(faut il être inscrit pour accéder à ces données ? )

.....ton code

.WebSingleBlockTextImport = False

.WebDisableDateRecognition = False

.WebDisableRedirections = False

.Refresh BackgroundQuery:=False

End With

..... fin de ton code

If i = 1 Then

li = i

Cells(li + 1, 1).Value = "Ligne " & i & " J " & j

Else

li = [B65000].End(xlUp).Row

Cells(li - 25, 1).Value = "Ligne " & i & " J " & j

End If

..... suite de ton code

Le 17/11/2015 à 14:13

Non il faut pas être inscript.

Et j'ai essaye cela ne fonctionne pas correctement

Cela m'affiche 01/02/2014 alors qu'on est en janvier. De plus, les lignes ne se coller pas sur toute les lignes de A.

5recuperation-de-donnees.xlsm (82.37 Ko)

Le 17/11/2015 à 14:22

Bonjour

Comme la cavalerie (après la bataille)

Modifie le début de ton code

Sub Macro1()

  Cells.ClearContents
  For j = 0 To 11
    For i = 1 To 31
     Range("A" & Range("B" & Rows.Count).End(xlUp).Row + 1) = DateSerial(2014, j + 1, i)

      With ActiveSheet.QueryTables.Add(Connection:= _
                                       "URL;http://www.meteociel.fr/temps-reel/obs_villes.php?code2=7005&jour2=" & i & "&mois2=" & j & "&annee2=2014" _
                                       , Destination:=Range("B" & Rows.Count).End(xlUp).Offset(1, 0))

Le 17/11/2015 à 14:41

Cela fonctionne vraiment bien Merci

Mais cela ne me copier coller pas à la suite la date. Pour 23h - 22h - 21h - 20h etc

Le 17/11/2015 à 17:03

Bonjour