Выберите ячейки в диапазоне для импорта на основе даты в другом диапазоне - PullRequest
0 голосов
/ 16 апреля 2019

Я пытаюсь импортировать данные из исходной рабочей книги в новую рабочую книгу.Источник имеет сегодняшнюю дату в ячейке А11.Диапазон A13: A1300 имеет даты, которые старше сегодняшней даты, вплоть до сегодняшней даты и в будущем сегодняшней даты.

Я хочу отсканировать даты в диапазоне источников A13: A1300, и если они старше, чем сегодняшняя дата, то я хочу скопировать / импортировать данные из диапазона источников D13: F1300 в новую рабочую книгу.Будут данные в D13: F1300, которые находятся в будущем сегодняшней даты (на основе диапазона A13: A1300).Если это дата в будущем, то я хочу игнорировать / не копировать / не импортировать данные из источника D13: F1300 - следовательно, я хочу сохранить целевые значения нетронутыми для диапазона D13: F1300 для любой даты в будущем в диапазонеA13: A1300

Ниже у меня есть код, который работает, в том смысле, что нет ошибок, и данные копируются, однако он копирует все, независимо от даты.Я также попробовал приведенный ниже код без «Else», и снова, он работает, но затем некоторые ячейки в пределах диапазона копируются правильно, а некоторые нет, и опять же, ячейки за пределами диапазона дат все еще копируются.Если бы кто-то мог предложить предложение, оно было бы очень признательно.

Спасибо!

    Sub TransferData()
If Workbooks.Count > 1 Then

'For HELOC tab
Dim rngSrc As Range
Dim rngDest As Range
Dim rngSDate As Range
Dim i As Long
Dim cS As Range
Dim cD As Range
Dim cT As Range
Dim M As String

Set rngSrc = Workbooks("SourceBookData.xlsx").Worksheets("HELOC").Range("D13:F1300")
Set rngDest = Workbooks(1).Worksheets("DestinationTab").Range("D13:F1300")
Set rngSDate = Workbooks("SourceBookData.xlsx").Worksheets("HELOC").Range("A13:A1300")
M = Date  'Also tried: M = Workbooks("SourceBookData.xlsx").Worksheets("HELOC").Range("A11")

For i = 1 To rngSrc.Cells.Count
Set cS = rngSrc.Cells(i)
Set cD = rngDest.Cells(i)
Set cT = rngSDate.Cells(i)
If cT < M Then
cD.Value = cS.Value
Else
cD.Value = cD.Value
End If
Next i

Workbooks(2).Close savechanges:=False

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...