マクロのWEBデータの取り込み
下のように書いてマクロを実行したのですが（EXCEL2003）
Sheet1のA1からDP１０００のデータをクリアにしてから
URLのデータを取り込んで
D列の最終行の値を
Sheet2のA列の日付+１行に書き込みたいのですが
Sheet1のA1からDP１０００のデータをクリアにする前に
D列の最終行の値を
Sheet2のA列の日付+１行に書き込んでしまいます。
あとConst Col = 4の部分が
同じ範囲内で宣言が重複しています。
とエラーになります。
どこが悪いのかがわかりません。
よろしくお願いします。
Sub 抽出()
Worksheets("Sheet1").Range("A1:DP1000").Value = ""
nen = InputBox("読み込む年度、西暦４桁（半角）読み込む月（半角）を入力")
tuki = InputBox("読み込む日（半角）を入力")
strUrl= "URL;http://○○○○★★★★DATFR=#01&DATTO=#$&MSCD=1431&BMCD=30&MENU_ID=2&MENU_ID1=2"
strnen = Mid(Str(nen), 2)
strtuki = Mid(Str(tuki), 2)
strUrl = Replace(Replace(strUrl, "$", strtuki), "#", strnen)
strName = Replace(Replace(strName, "$", strtuki), "#", strnen)
With Worksheets("野菜").QueryTables.Add(Connection:=strUrl, Destination:=Worksheets("Sheet1").Range("A1"))
.Name = strtuki
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=True
End With
Const Col = 4
Dim Rw As Long
With Sheets("Sheet1")
Rw = .Cells(Rows.Count, Col).End(xlUp).Row
Sheets("Sheet2").Range("A" & tuki + 1 & ":A" & tuki + 1).Value = _
.Range(.Cells(Rw, 4), .Cells(Rw, 4)).Value
End With
strUrl= "URL;http://○○○○■■■■DATFR=#01&DATTO=#$&MSCD=1431&BMCD=30&MENU_ID=2&MENU_ID1=2"
strnen = Mid(Str(nen), 2)
strtuki = Mid(Str(tuki), 2)
strUrl = Replace(Replace(strUrl, "$", strtuki), "#", strnen)
strName = Replace(Replace(strName, "$", strtuki), "#", strnen)
With Worksheets("Sheet3").QueryTables.Add(Connection:=strUrl, Destination:=Worksheets("Sheet3").Range("A1"))
.Name = strtuki
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=True
End With
Const Col = 4
Dim Rw As Long
With Sheets("Sheet3")
Rw = .Cells(Rows.Count, Col).End(xlUp).Row
Sheets("Sheet4").Range("A" & tuki + 1 & ":A" & tuki + 1).Value = _
.Range(.Cells(Rw, 4), .Cells(Rw, 4)).Value
End With
End Sub
お礼
ありがとう御座いました。
補足
回答ありがとう御座います。私は正規の登録ユーザです。 login、直接リンクへ移動しても、データが取り込めませんでした。難しいようですね。