Почему сценарий VBA не копирует/перемещает записи в следующую пустую строку?
Я реализовал функцию в VBA со следующими целями:
- Скопируйте значения из диапазона (A8:F400) на вкладке «Один столбец» в столбцы (AA2:AF) на вкладке «Индекс».
- Критерии копирования записей из «Одного столбца», если в столбце D есть значение (не нулевое).
- После копирования указанных записей, соответствующих этому критерию, вставьте значения и числовые форматы, найдите первую доступную строку на вкладке «Индекс» и вставьте диапазон.
Текущая проблема: при запуске/выполнении сценария vba набор данных копируется в соответствующие столбцы, но вставляется в диапазон от 20 000 до 80 000 строк, что превышает тысячи пустых строк. Я пытался выполнить сценарий несколько раз, но вставка продолжает превышать все пустые ячейки и добавляет набор данных дальше на вкладку моего индексного листа.
Sub MoveListToIndex()
'Find the last used row in both sheets and copy and paste data below existing data.
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
Dim Answer As VbMsgBoxResult
Answer = MsgBox("Are you sure you want to Submit the List?", vbYesNo, "Submit List")
If Answer = vbYes Then
Dim D As Range
Set D = Worksheets("Single Column").Range("D7:D400")
'Set variables for copy and destination sheets
Set wsCopy = Worksheets("Single Column")
Set wsDest = Worksheets("Index")
For Each cell In D
If cell.Value <> "" Then
'1. Find last used row in the copy range based on data in column D
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "D").End(xlUp).Row
'2. Find first blank row in the destination range based on data in column AA
'Offset property moves down 1 row
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "AA").End(xlUp).Offset(1).Row
'3. Copy & Paste Data
wsCopy.Range("A8:F400" & lCopyLastRow).Copy
wsDest.Range("AA" & lDestLastRow).PasteSpecial xlPasteValuesAndNumberFormats
End If
Next cell
Application.ScreenUpdating = True
MsgBox "The List has been Successfully Added!"
End If
End Sub
Интересно, нужен ли wsCopy.Range("A8:F400" & lCopyLastRow).CopywsCopy.Range("A8:F" & lCopyLastRow).Copy
Поставьте часы на lCopyLastRow и lDestLastRow, затем выполните код.
@nkalvi - спасибо, когда я пытался изменить wsCopy.Range, как уже упоминалось, записи вставлялись, но также зацикливались, по сути, вставляя один и тот же набор данных много раз, дублируя данные. Кажется, проблема в том, как я настроил операторы For Loop и IF.
@TimWilliams, спасибо, я попытался очистить все записи в столбце AA, затем нажал Ctrl + Up, как указано, и это привело меня к верхней строке заголовка (1).
@JarvisDavis, да, я думаю, есть две проблемы. Вы можете изменить метод на 1) установить lCopyLastRow на основе последней непустой ячейки в D (возможно, с помощью цикла или с помощью CountA) 2) Без цикла использовать wsCopy.Range("A8:F" & lCopyLastRow).Copy. В настоящее время вы копируете диапазон для каждой непустой ячейки в столбце D.
Ответы 1
Вот альтернатива, которую можно попробовать:
Sub MoveListToIndex()
'Find the last used row in both sheets and copy and paste data below existing data.
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
Dim Answer As VbMsgBoxResult
Answer = MsgBox("Are you sure you want to Submit the List?", vbYesNo, "Submit List")
If Answer = vbYes Then
Dim D As Range
Set D = Worksheets("Single Column").Range("D7:D400")
'Set variables for copy and destination sheets
Set wsCopy = Worksheets("Single Column")
Set wsDest = Worksheets("Index")
'1. Non-empty in D - header row + row to the first cell D7
lCopyLastRow = Application.WorksheetFunction.CountA(D) - 1 + 7
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "AA").End(xlUp).Offset(1).Row
'2. Copy & Paste Data
wsCopy.Range("A8:F" & lCopyLastRow).Copy
wsDest.Range("AA" & lDestLastRow).PasteSpecial xlPasteValuesAndNumberFormats
'Debug.Print "A8:F" & lCopyLastRow
Application.ScreenUpdating = True
MsgBox "The List has been Successfully Added!"
End If
End Sub
спасибо, что следили за мной и нашли время проверить, были ли проблемы с моим предыдущим сценарием. Я протестировал предоставленный вами пример, и он работает так, как и ожидалось. Спасибо
Рад это слышать, удачи в вашем проекте!
У вас может быть контент, которого вы не ожидаете. Какова ценность
lDestLastRow? Если вы перейдете к последней ячейке столбца AA на листе назначения и нажмете Ctrl + Up, куда это вас приведет?