Copy/Paste результаты

Question

я получил следующий код, который должен

1) Поиск по моему слову, копировать и вставлять всю строку, содержащую слово в новый лист

2) Поиск для слово после 1-го, затем скопируйте и вставьте эту целую строку рядом с содержимым 1) на новом листе.

Может кто-то взглянуть, у меня возникли проблемы с получением результатов, нет ошибки, которую я получаю. Поэтому я предполагаю, что это вся копия и вставка в мое новое имя листа. Однако я не уверен на 100%.

Sub stack() 

    Dim OSheet As String 
    Dim NSheet As String 
    Dim i As Integer 
    Dim LRow As Integer 
    Dim NSLRow As Integer 

    OSheet = "Sheet1" 'Old Sheet Name 
    NSheet = "Sheet7" 'New Sheet Name 

    LRow = Sheets(OSheet).Cells(Rows.Count, 1).End(xlUp).Row 'Last Row in Old Sheet 

    Sheets(OSheet).Activate 

    For i = 2 To LRow 
     'Finds last row in the New Sheet 
     If Sheets(NSheet).Cells(2, 1) = "" Then 
      NSLRow = 1 
     Else 
      NSLRow = Sheets(NSheet).Cells(Rows.Count, 1).End(xlUp).Row 
     End If 

     'If cell has "First Name then..." 
     Dim StrX As String 
    If InStr(LCase(Cells(i, 1)), LCase("stack:")) Then 
     StrX = Range(Cells(NSLRow + 1, 1), Cells(NSLRow + 1, 6)).Address 
     Sheets(NSheet).Range(StrX).Value = Range(StrX).Value 
    ElseIf InStr(LCase(Cells(i, 1)), LCase("overflow:")) Then 
     StrX = Range(Cells(NSLRow + 1, 7), Cells(NSLRow + 1, 8)).Address 
     Sheets(NSheet).Range(StrX).Value = Range(StrX).Value 
    End If 
    Next i 

End Sub 

EDIT, ожидаемый результат:

! http://i.imgur.com/69elWuB.jpg

EDIT, обновленный код с некоторыми исправлениями, о которых вы, ребята, упомянули.

Sub stackv2() 
    'added Sheets(OSheets)to Range Cells 
    Dim OSheet As String 
    Dim NSheet As String 
    Dim i As Integer 
    Dim LRow As Integer 
    Dim NSLRow As Integer 

    OSheet = "Sheet1" 'Old Sheet Name 
    NSheet = "Sheet7" 'New Sheet Name 

    LRow = Sheets(OSheet).Cells(Rows.Count, 1).End(xlUp).Row 'Last Row in Old Sheet 

    Sheets(OSheet).Activate 

    For i = 2 To LRow 
     'Finds last row in the New Sheet 
     If Sheets(NSheet).Cells(2, 1) = "" Then 
      NSLRow = 1 
     Else 
      NSLRow = Sheets(NSheet).Cells(Rows.Count, 1).End(xlUp).Row 
     End If 

     'If cell has "First Name then..." 
     Dim StrX As String 
    If InStr(LCase(Cells(i, 1)), LCase("first name")) Then 
     StrX = Sheets(OSheet).Range(Sheets(OSheet).Cells(NSLRow + 1, 1), Sheets(OSheet).Cells(NSLRow + 1, 6)).Address 
     Sheets(NSheet).Range(StrX).Value = Range(StrX).Value 
    ElseIf InStr(LCase(Cells(i, 1)), LCase("last name")) Then 
     StrX = Sheets(OSheet).Range(Sheets(OSheet).Cells(NSLRow + 1, 7), Sheets(OSheet).Cells(NSLRow + 1, 8)).Address 
     Sheets(NSheet).Range(StrX).Value = Range(StrX).Value 
    End If 
    Next i 

End Sub 

Answer 1

Это будет работать для вашего примера:

Sub stackv2() 

    Dim OSheet As Worksheet 
    Dim NSheet As Worksheet 
    Dim i As long 
    Dim LRow As long 
    Dim NSLRow As Long 
    Dim cpyClm As Long 

    Set OSheet = Sheets("Sheet1") 'change to your Old Sheet Name 
    Set NSheet = Sheets("Sheet7") 'change to your New Sheet Name 
    cpyClm = 1 'change this to the number columns desired 

    'Finds last row in the New Sheet 
    NSLRow = NSheet.Cells(NSheet.Rows.Count, 1).End(xlUp).Row 

    With OSheet 
     LRow = .Cells(.Rows.Count, 1).End(xlUp).Row 'Last Row in Old Sheet 

     For i = 2 To LRow 

      'If cell has "First Name then..." 

      If InStr(LCase(.Cells(i, 1)), LCase("first name")) Then 
       NSLRow = NSLRow + 1 'moves to new row every time this is true. 
       NSheet.Cells(NSLRow, 1).Resize(, cpyClm).Value = .Cells(i, "A").Resize(, cpyClm).Value 
      ElseIf InStr(LCase(Cells(i, 1)), LCase("last name")) Then 
       NSheet.Cells(NSLRow, 1 + cpyClm).Resize(, cpyClm).Value = .Cells(i, "A").Resize(, cpyClm).Value 
      ElseIf InStr(LCase(Cells(i, 1)), LCase("middle name")) Then 
       NSheet.Cells(NSLRow, 1 + (cpyClm * 2)).Resize(, cpyClm).Value = .Cells(i, "A").Resize(, cpyClm).Value 
      End If 
     Next i 
    End With 

End Sub 

Но поскольку мы не знаем, что выглядит ваши истинные данные, как я поставил возможность изменить количество колонка для копирования. Кроме того, поскольку ваш пример не включает столбец A, и ваше объяснение требует его, вам нужно будет изменить столбец в ячейках на 1 вместо 2

Если это не поможет или поможет вам разобраться, как настроить его на вашем вам нужно будет опубликовать фактическое представление ваших данных и желаемого результата.