Установить значение всего столбца относительно скопированных данных

Question

У меня есть макрос, который копирует данные из одной рабочей книги и выводит их в таблицу в другой рабочей книге.Мне просто нужно, чтобы значение столбца «U» соответствовало скопированным строкам, чтобы иметь установленное значение «30».Я хотел бы, чтобы этот код был написан в конце кода копирования / вставки, чтобы все это работало вместе в одной подпрограмме.

Код для копирования / вставки:

Sub InsertData()

Dim wsCopy As Worksheet, wsDest As Worksheet
Dim DefCopyLastRow As Long, DefDestLastRow As Long


'Set variables for copy and destination sheets
Set wsCopy = Workbooks("Warranty Template.xlsm").Worksheets("PivotTable")
Set wsDest = Workbooks("QA Matrix Template.xlsm").Worksheets("Plant Sheet")

'1. Find last used row in the copy range based on data in column A
DefCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, 1).End(xlUp).Offset(-1, 0).Row



'2. Find first blank row in the destination range based on data in column D
'Offset property moves down 1 row
DefDestLastRow = wsDest.Cells(wsDest.Rows.Count, 4).End(xlUp).Offset(1, 0).Row



'3. Copy & Paste Data
wsCopy.Range("A5:A" & DefCopyLastRow).Copy _
wsDest.Range("D" & DefDestLastRow)

wsCopy.Range("B5:B" & DefCopyLastRow).Copy _
wsDest.Range("E" & DefDestLastRow)

wsCopy.Range("B5:B" & DefCopyLastRow).Copy _
wsDest.Range("F" & DefDestLastRow)

wsCopy.Range("D5:D" & DefCopyLastRow).Copy _
wsDest.Range("I" & DefDestLastRow)

wsCopy.Range("E5:E" & DefCopyLastRow).Copy _
wsDest.Range("L" & DefDestLastRow)

wsDest.Range("U12:U" & DefDestLastRow).Value = 30
End Sub

Iпопытался добавить последнюю строку перед "End Sub", но это не помогло ...

Изображение выводимых данных в таблице:

Answer 1

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

NewLastRow = wsDest.Cells(wsDest.Rows.Count, 4).End(xlUp).Row
wsDest.Range("U" & DefDestLastRow & ":U" & NewLastRow).Value = 30

Ваш исправленный код:

Sub InsertData()

Dim wsCopy As Worksheet, wsDest As Worksheet
Dim DefCopyLastRow As Long, DefDestLastRow As Long, NewLastRow As Long


'Set variables for copy and destination sheets
Set wsCopy = Workbooks("Warranty Template.xlsm").Worksheets("PivotTable")
Set wsDest = Workbooks("QA Matrix Template.xlsm").Worksheets("Plant Sheet")

'1. Find last used row in the copy range based on data in column A
DefCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, 1).End(xlUp).Offset(-1, 0).Row

'2. Find first blank row in the destination range based on data in column D
'Offset property moves down 1 row
DefDestLastRow = wsDest.Cells(wsDest.Rows.Count, 4).End(xlUp).Offset(1, 0).Row


'3. Copy & Paste Data
wsCopy.Range("A5:B" & DefCopyLastRow).Copy _
wsDest.Range("D" & DefDestLastRow)

wsCopy.Range("B5:B" & DefCopyLastRow).Copy _
wsDest.Range("F" & DefDestLastRow)

wsCopy.Range("D5:D" & DefCopyLastRow).Copy _
wsDest.Range("I" & DefDestLastRow)

wsCopy.Range("E5:E" & DefCopyLastRow).Copy _
wsDest.Range("L" & DefDestLastRow)

NewLastRow = wsDest.Cells(wsDest.Rows.Count, 4).End(xlUp).Row
wsDest.Range("U" & DefDestLastRow & ":U" & NewLastRow).Value = 30

End Sub