Копирование отфильтрованных данных из набора таблиц и вставка их в следующую пустую строку другого листа

Question

Я попытался скопировать набор отфильтрованных данных из рабочего листа «PEP» (Фильтр: Emetteurs, в столбце 18) и вставить его в следующую пустую строку в рабочем листе «Санкции». Я нашел этот текстовый код в сети и добавил раздел NextRow, чтобы вставить его в следующую пустую строку на листе «Санкции». Я только недавно начал использовать VBA go, поэтому я пытался использовать коды онлайн, однако в этом случае, я думаю, проблема в том, что я не могу определить значение диапазона. Я пытался посмотреть онлайн, но безрезультатно. Заранее благодарю за помощь!

Dim k,j,i As Interger
ActiveWorkbook.Sheets("Sanctions").Select
NextRow=Cells(Range("A"&Rows.Count).End(xlUp).Row+1,1

k=1
With sheets("PEP")
 T=.Range("A1:AS"&.Cells(Rows.Count,1).End(xlUp).Row)
 .Rows(1).Copy Sheets("Sanctions").Range("NextRow")
End With

For i=2 To UBound(T,1)
 If T(i,18)="Emetteurs" Then
   k=k+1
   For j =1 to UBound(T,2)
    T(k,j)=T(i,j)
   Next j 
 End If

Next i
With Sheets("Sanctions")
 Application.ScreenUpdating=False
 .Range("NextRow").Resiwe(k,UBound(T,2))=T.Offset(1)
 .Columns.AutoFit
 Application.ScreenUpdating=True
End With
End Sub

И, если возможно, я также хотел бы найти решение для удаления заголовка после выполнения процесса копирования-вставки.

Answer 1

Прочитайте комментарии к коду и настройте его в соответствии с вашими потребностями.

Некоторые вещи для начала:

1. Используйте явную опцию , чтобы у вас не было неожиданное поведение с неопределенными переменными
2. Всегда делайте отступ в своем коде (см. www.rubberduckvba.com бесплатный инструмент, который поможет вам в этом)
3. Попробуйте отделить ваши логики c, определяя переменные и их повторное использование

---

РЕДАКТИРОВАТЬ: Некоторые отзывы к вашему коду:

1. Как упомянуто @ Pᴇʜ вам нужно объявлять каждый из ваших типов переменных.

   Это:

   Dim k,j,i As Interger
   

   - это то же самое, что и объявление:

   Dim k As Variant
   Dim j As Variant
   Dim i As Integer
   

   Сторона примечание. У вас была опечатка в Interger

   Это не то, что вы действительно хотите, зная, что все они будут хранить номера

---

Объявите объекты, с которыми вы собираетесь работать. Например, вы обращаетесь к листу Санкции три раза в своем коде:

ActiveWorkbook.Sheets("Sanctions")

Это можно установить один раз так:

Set targetSheet = ThisWorkbook.Worksheets("Sanctions")

И затем использовать повторно в таких строках:

With Sheets("Sanctions")

или это:

Sheets("Sanctions").Range("NextRow")

, написав это:

With targetSheet

таким образом, если вам когда-нибудь понадобится изменить его (человек, работающий с вашим кодом, или ваше будущее, вы будете очень благодарны)

---

Объявление ваших переменных просто буквами делает ваш код действительно трудным для понимания.

Dim j,k,l

отличается, когда у вас есть:

Dim lastRow As Long
Dim lastColumn As Long
etc.

---

Я предлагаю вам воспользоваться ключом F8, пройтись по коду и увидеть логи c позади него. Таким образом, вы можете узнать больше.

---

Код:

Public Sub ConditionalRowCopy()

    ' Declare object variables
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim cell As Range

    ' Declare other variables
    Dim sourceLastRow As Long
    Dim targetLastRow As Long

    ' Set a reference to the sheets so you can access them later
    Set sourceSheet = ThisWorkbook.Worksheets("PEP")
    Set targetSheet = ThisWorkbook.Worksheets("Sanctions")

    ' Find last row in source sheet based on column "R"
    sourceLastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "R").End(xlUp).Row

    ' Find cell with word "Emetteurs", search in column R)
    For Each cell In sourceSheet.Range("R1:R" & sourceLastRow).Cells

        ' If match
        If cell.Value = "Emetteurs" Then
            ' Find last row in target sheet based on column "A"
            targetLastRow = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row
            ' Copy entire row to next empty row in target sheet
            cell.EntireRow.Copy Destination:=targetSheet.Range("A" & targetLastRow).Offset(RowOffset:=1)
        End If

    Next cell

End Sub

Дайте мне знать, если это работает!