VBA сохраняет информацию после синхронизации базы данных

Question

Итак, в Рабочей книге у меня есть две рабочие таблицы: одна из них содержит таблицу идей, связанную с базой данных SQL, а другая будет иметь определенные идеи, выбранные из этой таблицы.

Из таблицы базы данных я хочу скопировать идеи, которые соответствуют определенным критериям, во вторую таблицу.Там они получат определенные числовые ранжировки пользователем

Idea 1    0    4    5    3    8
Idea 2    7    5    1    5    4
Idea 3    1    2    8    8    2

. По часам включенной кнопки я хочу обновить таблицу базы данных и скопировать любые идеи NEW втаблица рейтингов, так что она может напоминать следующее.

Idea 1    0    4    5    3    8
Idea 2    7    5    1    5    4
Idea 3    1    2    8    8    2
New Idea1  
New Idea2  

Как мне выполнить это копирование?Я не могу представить способ сделать это без перезаписи уже включенных оценок.

Код

Код, используемый для копирования всех идентификационных номеров в таблицу рейтингов.

Sub CopyFilter()

Dim rng As Range
Dim rng2 As Range

With ActiveSheet.AutoFilter.Range
    On Error Resume Next
        Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
            .SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
End With

If rng2 Is Nothing Then
    MsgBox "No data to copy"
Else
    Set rng = Worksheets("Ideas").ListObjects("IdeasTable"). _
        ListColumns(1).DataBodyRange
    rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy

    Worksheets("WFNs").Range("B5").PasteSpecial Paste:=xlPasteFormulas, _
    Operation:=xlNone, SkipBlanks:=False, Transpose:=False

End If

ActiveSheet.ShowAllData
Worksheets("WFNs").Activate

End Sub

Answer 1

Что вам нужно сделать, это сохранить информацию о том, что вы вставили. Сначала объявите глобальную переменную следующим образом:

Dim startRow as Long

В вашем сабе:

If startRow = 0 Then
    startRow = 1 
End If 

With ActiveSheet.AutoFilter.Range
    On Error Resume Next
        Set rng2 = .Offset(startRow, 0).Resize(.Rows.Count - 1, 1) _
            .SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
End With

Вместо того, чтобы всегда копировать весь диапазон, вы копируете только новые записи. Теперь, когда у вас есть начальная строка, вы можете использовать ее в своем if, чтобы вставить ваши данные ПОСЛЕ старой даты:

Else
    Set rng = Worksheets("Ideas").ListObjects("IdeasTable"). _
        ListColumns(1).DataBodyRange
    rng.Offset(startRow, 0).Resize(rng.Rows.Count - 1).Copy

    Worksheets("WFNs").Range("B" & (startRow + 4)).PasteSpecial Paste:=xlPasteFormulas, _
    Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    startRow = rng.Rows.Count - 1
End If

Я изменил только строки с startRow в нем. (Не проверено;))