Sub GetData()
Dim objWBConnect As WorkbookConnection
Dim StrSQL, DBYear, DBMonth, DBDay, DBHour, DEYear, DEMonth, DEDay, DEHour, StrID, StrPar As String
Dim i, j, k, id, Counter As Long
Dim DateBeg, DateEnd, Dateoff As Date
Dim sheet1 As Worksheet

k = 2
' берем ID и название параметра с листа CDBPoint
id = ActiveWorkbook.Worksheets(3).Cells(k, 1)
StrID = Trim(Str(id))
StrPar = ActiveWorkbook.Worksheets(3).Cells(k, 2)
StrPar = Mid(StrPar, 11)
Sheets.Add
ActiveSheet.Name = StrPar
ActiveSheet.Columns("E").NumberFormat = "mm/dd/yyy hh:mm:ss"
DateBeg = CDate("01 09 2018 00:00:00")
DateEnd = CDate("04 09 2018 00:00:00")
Dateoff = CDate("01 09 2019 00:00:00")
'номер строки куда пишем
Counter = 1
' цикл по таблице CHistoric с 01.09.2018 по 01.09.2019
While DateBeg < Dateoff

DBYear = Trim(Str(Year(DateBeg)))
If Month(DateBeg) < 10 Then DBMonth = "0" + Trim(Str(Month(DateBeg))) Else DBMonth = Trim(Str(Month(DateBeg)))
If Day(DateBeg) < 10 Then DBDay = "0" + Trim(Str(Day(DateBeg))) Else DBDay = Trim(Str(Day(DateBeg)))
If Hour(DateBeg) < 10 Then DBHour = "0" + Trim(Str(Hour(DateBeg))) Else DBHour = Trim(Str(Hour(DateBeg)))

DEYear = Trim(Str(Year(DateEnd)))
If Month(DateEnd) < 10 Then DEMonth = "0" + Trim(Str(Month(DateEnd))) Else DEMonth = Trim(Str(Month(DateEnd)))
If Day(DateEnd) < 10 Then DEDay = "0" + Trim(Str(Day(DateEnd))) Else DEDay = Trim(Str(Day(DateEnd)))
If Hour(DateEnd) < 10 Then DEHour = "0" + Trim(Str(Hour(DateEnd))) Else DEHour = Trim(Str(Hour(DateEnd)))


StrSQL = "SELECT TOP(50000) CDBHistoric.FormattedValue, CDBHistoric.Id," + _
"CDBHistoric.Quality, CDBHistoric.RecordTime, CDBHistoric.ValueAsReal " + _
"FROM Historic.CDBHistoric CDBHistoric " + _
"WHERE (CDBHistoric.Id=" + StrID + ")  AND " + _
"(CDBHistoric.RecordTime > TIMESTAMP '" + DBYear + "-" + Trim(DBMonth) + "-" + Trim(DBDay) + " " + DBHour + ":00:00')  " + _
"AND (CDBHistoric.RecordTime < TIMESTAMP '" + DEYear + "-" + Trim(DEMonth) + "-" + Trim(DEDay) + " " + DEHour + ":00:00') " + _
"ORDER BY  CDBHistoric.RecordTime"

ActiveWorkbook.Connections(4).ODBCConnection.CommandText = StrSQL
ActiveWorkbook.Connections(4).ODBCConnection.Refresh

  j = 2
 ' берем ID
 Cond = ActiveWorkbook.Worksheets(3).Cells(2, 1)
 '  цикл по строкам
 While ActiveWorkbook.Worksheets(1).Cells(j, 3) = Cond
 'цикл по столбцам
For i = 1 To 5
 ActiveSheet.Cells(Counter, i) = ActiveWorkbook.Worksheets(1).Cells(j, i)
Next i
 j = j + 1
 Counter = Counter + 1
Wend

' сдвигаем дату на три дня
DateBeg = DateEnd
DateEnd = DateAdd("d", 3, DateEnd)

Wend ' конец цикла по всему параметру

End Sub