Используя VBA для поиска данных в Excel по определенному слову, скопируйте эту строку и 2 строки выше и ниже на новый лист

Question

Мне нужна помощь с большим набором данных, которые у меня есть.Мне нужно иметь возможность искать данные по определенному слову (используя поле ввода), а затем указать, сколько строк выше и ниже этой строки появляется (снова используя поле ввода), чтобы также выбрать.Эти строки необходимо скопировать на новый лист, который, как я надеялся, будет назван в честь исходного поискового значения.

Пока у меня есть это

Private Sub CommandButton1_Click()
a = Worksheets("Database").Cells(Rows.Count, 1).End(xlUp).Row
nr = Application.InputBox("Enter customer name to find", "SEARCH VALUE")
        If nr = False Then Exit Sub

For i = 2 To a

If Worksheets("Database").Cells(i, 4).Value = nr Then

    Worksheets("Database").Rows(i).Copy
    Worksheets("Sheet2").Activate
    b = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
    Worksheets("Sheet2").Cells(b + 1, 1).Select
    ActiveSheet.Paste
    Worksheets("Database").Activate

End If

Next

End Sub

То, что у меня есть, так этоочень простой и копирует только выбранную строку и вводит строку в уже существующий лист -Sheet2.

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

Answer 1

После игры с дополнительной помощью от Ahmed AU мне удалось решить проблему.

Private Sub CommandButton1_Click()
a = Worksheets("Database").Cells(Rows.Count, 1).End(xlUp).Row
nr = Application.InputBox("Enter customer code", "SEARCH VALUE")
    If nr = False Then Exit Sub

N = InputBox("Enter additional number of rows", "Offset")
    If N = "" Then Exit Sub
    N = Val(N)

Sheets.Add After:=ActiveSheet
ActiveSheet.Name = nr
Worksheets("Database").Activate

For i = 2 To a

If Worksheets("Database").Cells(i, 4).Value = nr Then


Srow = IIf(i - N <= 0, i, i - N)
Erow = i + N
Worksheets("Database").Rows(Srow & ":" & Erow).Copy
Worksheets(nr).Activate
b = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
ActiveSheet.Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Database").Activate


End If

Next

End Sub

Answer 2

Попробуйте, после 1-го поля ввода

N = InputBox("Enter Number of Rows Above or below", "Offset")
        If N = "" Then Exit Sub
N = Val(N)

Затем после if ... Затем

Srow = IIf(i - N <= 0, i, i - N)
Erow = i + N
Worksheets("Database").Rows(Srow & ":" & Erow).Copy

Редактировать 2: при добавлении новой рабочей таблицы, я думаю, что добавленный вами кодХорошо.Но лучше проверить, есть ли уже лист с именем 'nr'
. Можно попробовать любое из следующих действий в соответствии с вашим требованием

have = False
    For Each ws In ActiveWorkbook.Worksheets
    If ws.Name = nr Then have = True
    Next

    If have = False Then
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = nr
    End If

ИЛИ

For Each ws In ActiveWorkbook.Worksheets
If ws.Name = nr Then ws.Delete
Next
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = nr