Скопируйте и вставьте строку с одного листа на другой в Excel
Я пытаюсь настроить систему архивации, при которой, когда пользователь выбирает «Да» в раскрывающемся списке столбцов и нажимает кнопку «Архивировать», все записи, выбранные для архивирования, будут перемещены на другой лист. Однако проблема, с которой я сталкиваюсь, заключается в том, что каждый раз, когда запись архивируется, она просто перезаписывает предыдущую запись, которая была заархивирована, поэтому на листе архива всегда есть только 1 строка. Это код, с которым я сейчас работаю
Sub Archive_Yes()
Dim MatchRow As Long, FirstRow As Long, LastRow As Long
Dim Destination As Range
Dim ws As Worksheet
Dim i As Long
Set ws = Sheets("Sales Order Log")
FirstRow = 14
LastRow = ws.Cells(ws.Rows.Count, "AA").End(xlUp).Row
i = FirstRow
Do While i <= LastRow
If ws.Range("AA" & i).Value = "Yes" Then
MatchRow = ws.Range("Z" & i).Row
With Sheets("Archive")
Set Destination = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With
ws.Range("A" & MatchRow & ":Z" & MatchRow).Copy Destination
ws.Rows(MatchRow).Delete Shift = xlUp
LastRow = LastRow - 1
Else
i = i + 1
End If
Loop
End Sub
Любое руководство будет очень признательно. Спасибо
Я надеялся, что это позволит вырезать и вставить всю информацию до столбца Z в любые строки, в которых есть «Да» в столбце архива, который имеет значение AA.
Вы хотите вставить в "AA:AA" или в "A:A"? Ваш код устанавливает (правильно) последнюю ячейку в столбце "А:А"... Я имею в виду Destination. Много ли таких строк нужно скопировать? Если это так, то более быстрым способом было бы поместить их в диапазон Union и скопировать их все сразу в конец кода. Если такой диапазон Union тоже будет огромным, его следует скопировать в несколько шагов. Могу показать как, если интересно... Но сначала уточните вопрос столбца куда вставлять.
Строки, которые необходимо вырезать, расположены от A: Z и должны быть взяты из листа под названием «Журнал заказов на продажу» и вставлены в лист под названием «Архив». Вероятно, в год архивируется около 200 строк.
Поэтому их нужно вставить в столбец «А:А» (листа «Архив»). Правильно ли это понимание?
Начиная со столбца A yes и до Z. AA не нужно вставлять, так как именно здесь принимается решение об архивации записи, и он просто содержит раскрывающийся список, содержащий «Да».
Ответы 2
Переместите строки критериев, используя AutoFilter
Sub Archive_Yes()
Const sName As String = "Sales Order Log"
Const sHeaderRowAddress As String = "A13:AA13"
Const CriteriaColumn As Long = 27
Const CriteriaString As String = "Yes"
Const dName As String = "Archive"
Const dFirstCellAddress As String = "A2"
Dim sws As Worksheet: Set sws = ThisWorkbook.Worksheets(sName)
If sws.FilterMode Then sws.ShowAllData
Dim srCount As Long
Dim srg As Range
With sws.Range(sHeaderRowAddress)
Dim slRow As Long
slRow = sws.Cells(sws.Rows.Count, CriteriaColumn).End(xlUp).Row
srCount = slRow - .Row + 1
If srCount < 2 Then Exit Sub ' no data or only headers
Set srg = .Resize(srCount)
End With
Dim scCount As Long: scCount = srg.Columns.Count
Dim sdrg As Range ' exclude headers and last column
Set sdrg = srg.Resize(srCount - 1, scCount - 1).Offset(1)
srg.AutoFilter CriteriaColumn, CriteriaString
Dim svrg As Range
On Error Resume Next
Set svrg = sdrg.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
sws.AutoFilterMode = False
If svrg Is Nothing Then
MsgBox "No filtered rows.", vbExclamation
Exit Sub
End If
Dim dws As Worksheet: Set dws = ThisWorkbook.Worksheets(dName)
Dim dfCell As Range
With dws.Range(dFirstCellAddress)
Dim dlRow As Long
dlRow = dws.Cells(dws.Rows.Count, .Column).End(xlUp).Row
If dlRow < .Row Then
Set dfCell = .Cells
Else
Set dfCell = dws.Cells(dlRow + 1, .Column)
End If
End With
svrg.Copy dfCell
svrg.EntireRow.Delete Shift:=xlShiftUp
MsgBox "Data archived.", vbInformation
End Sub
Пожалуйста, попробуйте следующий адаптированный код:
Sub Archive_Yes()
Dim FirstRow As Long, LastRow As Long, Destination As Range, rngDel As Range
Dim ws As Worksheet, i As Long
Set ws = Sheets("Sales Order Log")
FirstRow = 14
LastRow = ws.cells(ws.rows.count, "AA").End(xlUp).row
For i = FirstRow To LastRow
If ws.Range("AA" & i).value = "Yes" Then
AddRange rngDel, ws.Range("A" & i & ":Z" & i)
End If
Next i
Dim wsA As Worksheet, lastRowA As Long
Set wsA = Sheets("Archive")
lastRowA = wsA.Range("A" & wsA.rows.count).End(xlUp).row + 1
If Not rngDel Is Nothing Then
Debug.Print rngDel.Address, lastRowA: Stop
Application.ScreenUpdating = False: Application.EnableEvents = False
Application.Calculation = xlCalculationManual
rngDel.Copy wsA.Range("A" & lastRowA)
rngDel.EntireRow.Delete
Application.ScreenUpdating = True: Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End If
End Sub
Sub AddRange(rngU As Range, rngAdd As Range)
If rngU Is Nothing Then
Set rngU = rngAdd
Else
Set rngU = Application.Union(rngU, rngAdd)
End If
End Sub
Это должно быть очень быстро... Пожалуйста, отправьте отзыв после тестирования.
Спасибо за этот код. Я не уверен, что у меня есть какие-то другие настройки, но этот код очень похож на мой, у меня было две тестовые записи 11111 и 22222. Когда я заархивировал 11111, все было в порядке, когда я заархивировал 22222, он просто вставил 11111, а не под ним, поэтому архив показывает только одну архивную запись
@Strexxin Я не уверен, что смогу тебя достать ... Что означает «11111 и 22222»? Он вставил только одну строку? Это что значит "одна архивная запись"? Вы должны знать, что «да» и «да» или «да» отличаются от VBA тем, как вы пытаетесь его использовать... Если это проблема, я могу быстро адаптировать код. Можете ли вы поделиться макетом такой рабочей тетради, чтобы провести на ней несколько тестов?
Тестовых записей было две, я для простоты назвал их 11111 и 22222. Что я хочу для архива, так это чтобы каждая запись была вставлена под последней, поскольку она архивируется, поэтому все данные сохраняются. Однако в настоящее время происходит то, что каждая запись архивируется, она вставляется поверх предыдущей, что означает потерю данных.
@Strexxin Боюсь, это невозможно. Я тестировал код... Можете ли вы поделиться чем-нибудь красноречивым?
Значит, нельзя написать код, который просто находит следующую пустую строку и вставляет в нее запись?
@Strexxin Конечно, это можно сделать разными способами! Но установка последней пустой ячейки в «A:A» была правильной в вашем исходном коде, и я пытался адаптировать только остальную часть.
Это все, что мне нужно, чтобы код распознал последнюю строку и разместил там запись, мой код перезаписывал предыдущую запись, а это не то, что я хотел. Извините, кажется, я плохо объяснил
@Strexxin Хорошо. Я адаптирую код, чтобы по-другому вычислить пустую строку в «A: A», а затем построить диапазон с ее использованием.
@Strexxin Хорошо. Адаптирован код, чтобы сначала вычислить пустую строку, а затем вставить ее. Пожалуйста, протестируйте обновленную версию, но она должна корректно работать и с тем способом, который вы использовали... Если все еще проблематично, если вы не можете поделиться такой книгой (фиктивной), я не могу понять, что происходит в вашей среде. Если у вас есть Anydesk или TeamViewer и принимается удаленное подключение, я сразу пойму, что происходит... Поскольку код работает как надо на моем ноутбуке/книге, я не могу представить, что не так в вашем случае.
Кажется, теперь это работает, я не уверен, почему код, который я изначально опубликовал, не работает. Но спасибо за ваше время сегодня, я многому научился.
@Strexxin Я только что добавил строку отладки в приведенный выше код. Пожалуйста, запустите его и скажите, что он возвращает в Immediate Window при остановке на этой строке (Debug.Print rngDel.Address, lastRowA: Stop)
@Strexxin Я тоже не могу понять ... До модификации все работало так же. Теперь, если вы считаете, что вам нужно обработать гораздо больший диапазон вставляемых строк, код следует адаптировать для более частой вставки. Я имею в виду, что построение диапазона Union выполняется быстро для 100-200 диапазонов, но код значительно замедляется для больших диапазонов, поэтому хорошо установить лимит и время от времени вставлять и делать rngDel = Nothing...
Что вы ожидаете от линейки
MatchRow = ws.Range("Z" & i).Row? Так будет всегдаi...