Скопировать несколько строк из выбранных столбцов, если условие выполнено

Question

Иллюстрация:
У меня есть 2 листа: ShNote = справочная таблица и ShPPT = финальная таблица.
У меня есть 4 разных стола внутри финального стола.

Что я ищу: (4 условия)

1. Найдите значение = 20 в столбце E и скопируйте и вставьте значение и только имя клиента в столбце A на лист окончательной таблицы в 1-й таблице (C: D)

2. Найдите значение больше 17, но меньше 20 и скопируйте и вставьте значение и только имя клиента в столбце A на лист финальной таблицы во 2-й таблице (F: G)

3. Найдите значение больше 15, но меньше 17 и скопируйте и вставьте значение и только имя клиента в столбце A на лист окончательной таблицы в 3-й таблице (I: J)

4. Найдите значение больше 11, меньше 15 и скопируйте и вставьте значение и только имя клиента в столбце A на лист финальной таблицы в последней таблице (L: M)

Я только что обновил свой код, и он хорошо работает

Параметр Явный

Sub Analysis_ClientRating ()

Dim lastrow As Long, я As Long, rowppt As Long, colppt As Long Dim rowppt1 As Long, colppt1 As Long, rowppt2 As Long, colppt2 As Long Тусклый rowppt3 As Long, colppt3 As Long

lastrow = ShNote.Range("C" & Rows.Count).End(xlUp).Row
rowppt = ShPPT.Cells(Rows.Count, 1).End(xlUp).Row
colppt = ShPPT.Cells(Rows.Count, 1).End(xlUp).Row
rowppt1 = ShPPT.Cells(Rows.Count, 1).End(xlUp).Row
colppt1 = ShPPT.Cells(Rows.Count, 1).End(xlUp).Row
rowppt2 = ShPPT.Cells(Rows.Count, 1).End(xlUp).Row
colppt2 = ShPPT.Cells(Rows.Count, 1).End(xlUp).Row
rowppt3 = ShPPT.Cells(Rows.Count, 1).End(xlUp).Row
colppt3 = ShPPT.Cells(Rows.Count, 1).End(xlUp).Row

Call Entry_Point

For i = 6 To lastrow
    Select Case ShNote.Cells(i, 5).Value
        Case Is = 20
        ShNote.Cells(i, 3).Copy
        ShPPT.Cells(rowppt + 6, 3).PasteSpecial xlPasteValues
        ShNote.Cells(i, 5).Copy
        ShPPT.Cells(colppt + 6, 4).PasteSpecial xlPasteValues
        rowppt = rowppt + 1
        colppt = colppt + 1

        Case Is >= 17
        ShNote.Cells(i, 3).Copy
        ShPPT.Cells(rowppt1 + 6, 6).PasteSpecial xlPasteValues
        ShNote.Cells(i, 5).Copy
        ShPPT.Cells(colppt1 + 6, 7).PasteSpecial xlPasteValues
        rowppt1 = rowppt1 + 1
        colppt1 = colppt1 + 1

        Case Is >= 15
        ShNote.Cells(i, 3).Copy
        ShPPT.Cells(rowppt2 + 6, 9).PasteSpecial xlPasteValues
        ShNote.Cells(i, 5).Copy
        ShPPT.Cells(colppt2 + 6, 10).PasteSpecial xlPasteValues
        rowppt2 = rowppt2 + 1
        colppt2 = colppt2 + 1

        Case Is >= 11
        ShNote.Cells(i, 3).Copy
        ShPPT.Cells(rowppt3 + 6, 12).PasteSpecial xlPasteValues
        ShNote.Cells(i, 5).Copy
        ShPPT.Cells(colppt3 + 6, 13).PasteSpecial xlPasteValues
        rowppt3 = rowppt3 + 1
        colppt3 = colppt3 + 1


    End Select
Next i

Call Exit_Point End Sub

Answer 1

Звучит так, будто вы просто хотите, чтобы переключатель определял, куда все пойдет, так что (не проверено):

lrs = wss.cells(wss.rows.count,5).end(xlup).row
for i = 2 to lrs 'assumes headers in row 1
    select case wss.cells(i,5).value
        Case is = 20
            col = 3
        Case is => 17,  is < 20
            col = 6
        'fil in others
    end select
    lrd = wsd.cells(wsd.rows.count,col).end(xlup).row
    wsd.cells(lrd+1,col).value = wss.cells(i,1).value
next i

выяснить, где находится ваш столбец.можно найти в каждом столбце описания (lrd), поместив значение из зацикленного столбца A в исходной рабочей таблице (wss) в соответствующий столбец конечного листа (wsd).

Answer 2

Другая проблема

Если я не использую функцию Call, я получу такой результат Результат функции без вызова

[Main Table ] [2]