Добавить новую строку в таблицу и вставить данные из диапазона - PullRequest
0 голосов
/ 09 июля 2020

Меня попросили преобразовать данные в электронной таблице в таблицу.

В эту таблицу необходимо вставить данные из другой книги.

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

Это текущий код, который работает, пока данные не находятся в Форма таблицы.

Sub CopytoResults()

Dim destSht As Worksheet

Application.ScreenUpdating = False

'Copy the range 
ActiveSheet.Range("C52:AJ52").Select
Selection.Copy

'Open the Results spreadsheet and paste to the next available row
Workbooks.Open (ActiveWorkbook.Path & "\Quality_ResultsTST.xlsx")
Set destSht = ActiveWorkbook.Worksheets("Staff Results")

destSht.Activate

'Paste Data
destSht.Cells(Rows.Count, 1).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues

'Save and Close the Results Spreadsheet
destSht.Parent.Close True

'Set Focus to the QA_QC Assessment form
Application.CutCopyMode = False
Windows("QA Form V2.xlsm").Activate
ActiveSheet.Range("E7").Select

Application.ScreenUpdating = True
    
End Sub

Имя таблицы - Results

Я пробовал несколько решений с этого и других сайтов, но безрезультатно.

Я знаю, используя select et c дурной тон, но это не мой код, я обновляю старое приложение.

Большое спасибо

1 Ответ

1 голос
/ 09 июля 2020

Используя таблицу, это будет примерно так:

Sub CopytoResults()
    
    Dim rngSrc as range, wb as workbook
    
    Application.ScreenUpdating = False
    
    'Copy the range 
    Set rngSrc = ActiveSheet.Range("C52:AJ52")
    
    set wb = Workbooks.Open(ActiveWorkbook.Path & "\Quality_ResultsTST.xlsx") 'ThisWorkbook?
    
    'add a new row to the table and assign the data to its Range
    with wb.sheets("Staff Results").listobjects("Results").listrows.add.range
        .value = rngSrc.value 
    end with

    wb.close true
    thisworkbook.Activate
    ActiveSheet.Range("E7").Select
    
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...