Цикл внутри цикла?

[Number_30]

Добрый день!

Есть следующий код:

Private Sub Button1_Click()
Dim lItem As Long
Dim r As Integer
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("лист1")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("новый")
Dim ws3 As Worksheet: Set ws3 = ThisWorkbook.Sheets("input")
Dim test1 As String


For lItem = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(lItem) = True Then
        
    With ws3
    .Cells(1, 1).Value = ListBox1.List(lItem, 0)
    End With
    
        test1 = ws3.Cells(1, 1).Value
        For r = 3 To ws1.Range("H50").End(xlUp).Row
        If ws1.Cells(r, 8) = test1 Then
        ws1.Rows(r).Copy ws2.Rows(ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row + 1)
    End If
Next r

End If
   
Next lItem

MsgBox "Данные успешно скопированы"


End Sub

Суть работы, как должно быть - предварительно отмечаются checkbox-ом несколько строк в listbox-е расположенного на userform.
Делается клик по кнопке и из листа "лист1" копируются все строки, содержащие значение из listbox-a на новый лист "новый" (т.е. например, значение "BY1D" из листбокса повторяется 30 раз в листе "лист1" по столбцу "H", и все они должны копироваться).

как это выглядет согласно кода - клик по кнопке, выбранное значение из listbox-a копируется в ячейку А1 в листе "input", затем этой ячейке задается значение test1 и далее производится поиск строки содержащей значение из test1 в листе "лист1" по столбцу H . Он должен бы находить все строки, и копировать их один за другим на лист "новый". Но, он копирует только первую строку, даже если выбрано несколько элементов из листбокса... геморрой и еще и не работает.

Но, если в

If ws1.Cells(r, 8) = test1 Then

вместо test1 прописать какое нибудь постоянное значение, слово, то он работает - копирует все строки с этим словом.
Но проблема заключается в - как сделать, чтобы этот код работал для переменной ?

[Скрипт]

Пункт 1

Number_30, не решение вашей задачи, просто замечание по коду.
Можно сразу поместить данные в переменную test1 из Listbox.


Пункт 2

Ошибка у вас здесь:

ws1.Rows(r).Copy ws2.Rows(ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row + 1)

на листе ws2 неправильно определяется номер строки, куда вставлять данные. В вашем коде строка, куда нужно вставить данные, определяется по второму столбцу. Видимо у вас на листе ws2 во втором столбце пусто.

[Number_30]

Сообщение от Скрипт

Пункт 1

Number_30, не решение вашей задачи, просто замечание по коду.
Можно сразу поместить данные в переменную test1 из Listbox.

Пробовал так сделать, но от этого он ее вообще не видит как.

Видимо у вас на листе ws2 во втором столбце пусто.

Нет там все в порядке.

Сейчас попробовал так:

Private Sub Buttondrgcopynochange1_Click()
Dim i As Integer
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("лист1")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("новый")
Dim cell As Range

Application.ScreenUpdating = False
For Each cell In Range("H3:H50").Cells.SpecialCells(xlFormulas)
For i = 2 To ws1.Range("H50").End(xlUp).Row
    If ws1.Cells(i, 8) = "SPD1" Then
    ws1.Rows(i).Copy ws2.Rows(ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row + 1)
    End If
Next i
Next cell

End Sub

И он, в новый лист копирует первую попавшуюся строку из листа1 до 50-ой строки... Как задать правильно цикл? чтобы он для искомого значения копировал все строки с этим значением, а не только первую попавшуюся?

[Скрипт]

Number_30, протестируйте код в выложенной книге.
Работает он так, как нужно?

При нажатии на верхнюю кнопку, ListBox заполянется данными.
При нажатии на нижнюю кнопку, копируются строки на второй лист.

[Number_30]

Попробовал и заметил такой момент - скопировал свой код в ваш лист и все работает нормально.... возвращаюсь в свою книгу и опять, копирует только первую строку, сколько бы строк не выбирал. Когда же я попробовал вручную заполнить столбец Н, то и в моей книге все заработало. Но, стоит только мне протянуть формулу до конца (до строки Н6836), то опять все сбивается и копируется только одна строка - самая первая. Формула стоит простая - ="SPD"&C2 (C2 - динамическая по столбцу). Я слышал что в таких случаях надо задавать значение столбца что все значения это формулы? как быть?

[Скрипт]

Number_30, создайте примерную ситуацию в книге, которую я выложил. Убедитесь, что код не работает и выложите книгу на Форуме, пояснив, что не работает.

[Number_30]

Разобрался... я диапазон по столбцу Н указал не достаточный. Было всего Н6836, теперь указал Н8000 с запасом и все заработало.

Спасибо большое за помощь!

[Скрипт]

Number_30, может так вам определять номер последней строки с данными в столбце "H"?

Sub Procedure_1()

    Dim myLastRow As Long

    myLastRow = Worksheets(1).Range("H" & Worksheets(1).Rows.Count).End(xlUp).Row

End Sub

[Number_30]

Сообщение от Скрипт

Number_30, может так вам определять номер последней строки с данными в столбце "H"?

Sub Procedure_1()

    Dim myLastRow As Long

    myLastRow = Worksheets(1).Range("H" & Worksheets(1).Rows.Count).End(xlUp).Row

End Sub

Отличное решение! Спасибо!

[Скрипт]

Number_30, у вас такое уже применялось в вашем коде (сообщение #1):

ws1.Rows(i).Copy ws2.Rows(ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row + 1)