Найти значение в таблице, а затем скопировать значения из разных столбцов в другую таблицу - PullRequest
0 голосов
/ 13 марта 2019

У меня есть таблица в Sheet1 рабочей книги, и несколько строк таблицы будут иметь # N / A в качестве значения столбца N. Я хотел бы найти способ, чтобы макрос vba нашел все строки, которые имеют #N/ A в столбце N затем скопируйте значения из столбцов M и L этих строк в конец другой таблицы на Листе 2 той же книги.

ActiveSheet.ListObjects("SEC_Data").Range.AutoFilter Field:=14, Criteria1:= _
    "#N/A"
Range("M88343:M88351").Select
Selection.Copy
Sheets("LKUP_Client Name").Select
Range("B2").Select
Selection.End(xlDown).Select
Range("B" & ActiveCell.Row + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Sheets("company_2018 thru2019_gim").Select
Range("L88343:L88351").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("LKUP_Client Name").Select
Range("C").Select
Selection.End(xlDown).Select
Range("C" & ActiveCell.Row + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
End Sub

1 Ответ

0 голосов
/ 13 марта 2019

Я бы подошел к этому так: сначала переберите столбец N на листе 1, когда найдете # N / A, затем скопируйте ячейки и вставьте в соответствующее место на листе 2. Что-то вроде следующего:

Sub CopyProcedure()

    Dim i As Long
    Dim lRow1 As Long, lRow2 As Long
    Dim wsSheet1 As Worksheet, wsSheet2 As Worksheet

    Set wsSheet1 = Sheets("Sheet 1")
    Set wsSheet2 = Sheets("Sheet 2")

    lRow1 = wsSheet1.Range("N" & wsSheet1.Rows.Count).End(xlUp).Row

    'assuming your data starts in the first row
    'iterate to the last row of column n
    For i = 1 To lRow1
        'look for the #N/A text
        If wsSheet1.Range("N" & i).Text = "#N/A" Then
            'adjust this to suit which column in sheet 2 you need
            lRow2 = wsSheet2.Range("A" & wsSheet2.Rows.Count).End(xlUp).Row + 1
            'when text found copy required cells
            wsSheet1.Range("L" & i, "M" & i).Copy
            'paste cell values in required location on sheet 2
            'NOTE THIS WILL PASTE IN THE LAST ROW SPECIFIED ON SHEET 2 AND IN COLUMN A
            'adjust as you see fit
            wsSheet2.Range("A" & lRow2).PasteSpecial xlPasteValues
            'empty clipboard
            Application.CutCopyMode = False
        End If
    Next i

    Set wsSheet1 = Nothing
    Set wsSheet2 = Nothing

End Sub

Это ни в коем случае не самый эффективный способ сделать это, но я уверен, что он выполнит работу, если я правильно понимаю вашу проблему.

Кроме того, предостережение, я не проверял и не отлаживалэтот.:)

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...