Private Sub GetWeather_Click()
Application.ScreenUpdating = False
Set SRC = Application.Workbooks("WEATHER2.xls").Sheets("weather")
Set TRG = Application.Workbooks("WEATHER2.xls").Sheets("weather2")
SRC.Activate
Range("A6:e20").QueryTable.Refresh BackgroundQuery:=False
Range("f6:j20").QueryTable.Refresh BackgroundQuery:=False
Range("k6:o20").QueryTable.Refresh BackgroundQuery:=False
Range("p6:t20").QueryTable.Refresh BackgroundQuery:=False
Range("u6:y20").QueryTable.Refresh BackgroundQuery:=False
Range("z6:ad20").QueryTable.Refresh BackgroundQuery:=False
Range("ae6:ai20").QueryTable.Refresh BackgroundQuery:=False
For i = 6 To 20
If SRC.Cells(i, 1) = "3pm" Then
TRG.Cells(2, 6) = SRC.Cells(i, 2)
TRG.Cells(2, 5) = SRC.Cells(i, 3)
End If
If SRC.Cells(i, 6) = "3pm" Then
TRG.Cells(3, 6) = SRC.Cells(i, 7)
TRG.Cells(3, 5) = SRC.Cells(i, 8)
End If
If SRC.Cells(i, 11) = "3pm" Then
TRG.Cells(4, 6) = SRC.Cells(i, 12)
TRG.Cells(4, 5) = SRC.Cells(i, 13)
End If
If SRC.Cells(i, 16) = "3pm" Then
TRG.Cells(5, 6) = SRC.Cells(i, 17)
TRG.Cells(5, 5) = SRC.Cells(i, 18)
End If
If SRC.Cells(i, 21) = "3pm" Then
TRG.Cells(6, 6) = SRC.Cells(i, 22)
TRG.Cells(6, 5) = SRC.Cells(i, 23)
End If
If SRC.Cells(i, 26) = "3pm" Then
TRG.Cells(7, 6) = SRC.Cells(i, 27)
TRG.Cells(7, 5) = SRC.Cells(i, 28)
End If
If SRC.Cells(i, 31) = "3pm" Then
TRG.Cells(8, 6) = SRC.Cells(i, 32)
TRG.Cells(8, 5) = SRC.Cells(i, 33)
End If
Next
TRG.Activate
Cells.Replace What:="°C", Replacement:="", _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
False, ReplaceFormat:=False
TRG.Range("A2:F8").Copy
TRG.Range("A12:F18").Insert Shift:=xlDown
TRG.Range("A12").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks.Open Filename:="\\cog\bi_application\data\Weather\WEATHER.xls", UpdateLinks:=False
Set TRG2 = Application.Workbooks("WEATHER.xls").Sheets("Upload weather info")
TRG.Activate
TRG.Range("E2:F8").Copy
TRG2.Activate
TRG2.Range("E2:F8").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.Run ("WEATHER.xls!UploadToAccess")
Application.DisplayAlerts = False
'ws.Visible = xlSheetVisible
Workbooks("WEATHER.xls").Close SaveChanges:=True
Workbooks("WEATHER2.xls").Save
Application.DisplayAlerts = True
End Sub
|
