Если значение ячейки уже находится в столбце в другом wbk - PullRequest
0 голосов
/ 29 ноября 2018

Я немного растерялся с моим кодом.По сути, код выполняет копирование и вставку определенных строк из одного рабочего листа в разные рабочие книги, если выполняются некоторые условия.

  1. Если значение в строке из моего выбора (от строки 16 до последней строки) равно диапазону "A10 "И если значение из строки (i, 4) = рабочий поток (имя другой рабочей книги, которая должна быть открыта с помощью кода vba), откройте рабочую книгу и ...
  2. Вставьте строку в диапазоне A16если пусто, если нет - найдите последнюю строку и вставьте данные в первую «свободную» строку и закройте книгу.

Также есть два цикла.1. Рабочий поток - проходит по каждому имени рабочей книги (для j = от 2 до 10) 2. Пройдет по каждой строке в моей таблице (от i = 16 до lastrow).

То, что я хочу добавить в качестве условия:что если значение из Mastersheet (i, 1) уже находится в столбце A рабочей книги, то ничего не делайте и перейдите к следующему i.

Ниже приведен код:

Sub copypaste()

Dim i As Integer
Dim j As Integer
Dim strFileName As String
Dim strFilePath As String

Getbook = ActiveWorkbook.Name
lastrow = Worksheets("Master").Range("D16").End(xlDown).Row

Application.screenupdating = False

strFilePath = "C:\Users\mxr0520\Desktop\CTA SSS\"

    For j = 2 To 10
    For i = 16 To lastrow

    Workbooks(Getbook).Activate
    If Workbooks(Getbook).Worksheets("Master").Cells(i, 11) = Worksheets("Master").Range("A10") Then

    workstream = Workbooks(Getbook).Worksheets("Database").Cells(j, 2).Value
    strFileName = workstream & ".xlsm"

        If Workbooks(Getbook).Worksheets("Master").Cells(i, 4) = workstream Then

        Workbooks(Getbook).Worksheets("Master").Range(Cells(i, 1), Cells(i, 16)).Select
        Selection.Copy
        Set wbkopen = Workbooks.Open(strFilePath & strFileName, False, False)

            If Worksheets(workstream).Range("A16") = "" Then
            Worksheets(workstream).Range("A16").PasteSpecial Paste:=xlPasteValues
            Else
            LastRow2 = Worksheets(workstream).Range("A15").End(xlDown).Row
            Worksheets(workstream).Cells(LastRow2 + 1, 1).PasteSpecial Paste:=xlPasteValues
            End If

        Workbooks(workstream & ".xlsm").Close savechanges:=True

        Else

        End If

    Else

    End If

    Next i

    Next j

Application.screenupdating = True
Application.CutCopyMode = False

Range("A1").Select

MsgBox "Done"

End Sub

спасибо!

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