Скопируйте определенные ячейки из одной книги в разные ячейки в другой в зависимости от условия

Question

У меня есть книга под названием «EvaluationLog.xlsm», и мне нужно перенести определенные ячейки (не всю строку) из первого рабочего листа в другую существующую книгу под названием «EvaluationLog.xlsm», IndicatorLog.xlsm 'находится в том же каталоге. Целевой лист также является первым. Я пытаюсь, чтобы макрос размещался в книге «IndicatorLog».

Конкретные ячейки в каждой строке источника должны копироваться только в том случае, если содержимое в столбце «O» равно «Нет», или если содержимое столбца «J» равно «Initial». Фактические исходные данные начинаются в строке 8, а целевой диапазон также начинается в строке 8.

Мне никогда не приходилось вводить код в VBA раньше, за исключением нескольких очень простых задач, поэтому я застрял.

Любая помощь будет принята с благодарностью! :)

Sub MergeFromLog() 

Dim TargetSheet As Worksheet 
Dim FolderPath As String 
Dim NRow As Long 
Dim SourceFileName As String 
Dim WorkBk As Workbook 
Dim LastRow As Integer, i As Integer, erow As Integer 

' Set destination file. 
Set TargetSheet = ActiveWorkbook.Worksheets(1) 

' Modify this folder path to point to the files you want to use as source. 
FolderPath = "" 

' Set source file. 
SourceFileName = FolderPath & "2015-2016 Evaluation Log.xlsm" 

' NRow keeps track of where to insert new rows in the destination workbook. 
NRow = 8 

' Open the source workbook in the folder 
Set WorkBk = Workbooks.Open(SourceFileName) 

LastRow = WorkBk.ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row 

For i = 8 To LastRow 

    If WorkBk.Range(“O” & i) = "No" Or WorkBk.Range(“J” & i) = “Initial” Then 

     ' Copy Student Name 
     TargetSheet.Range("A" & NRow).Value = WorkBk.Range(“A” & i).Value 
     ' Copy DOB 
     TargetSheet.Range("B" & NRow).Value = WorkBk.Range(“C” & i).Value 
     ' Copy ID# 
     TargetSheet.Range("C" & NRow).Value = WorkBk.Range(“D” & i).Value 
     ' Copy Consent Day 
     TargetSheet.Range("D" & NRow).Value = WorkBk.Range(“L” & i).Value 
     ' Copy Report Day 
     TargetSheet.Range("E" & NRow).Value = WorkBk.Range(“N” & i).Value 
     ' Copy FIE within District Timelines? 
     TargetSheet.Range("F" & NRow).Value = WorkBk.Range(“O” & i).Value 
     ' Copy Qualified? 
     TargetSheet.Range("H" & NRow).Value = WorkBk.Range(“A” & i).Value 
     ' Copy Primary Eligibility 
     TargetSheet.Range("I" & NRow).Value = WorkBk.Range(“U” & i).Value 
     ' Copy ARD Date 
     TargetSheet.Range("J" & NRow).Value = WorkBk.Range(“R” & i).Value 
     ' Copy ARD within District Timelines? 
     TargetSheet.Range("K" & NRow).Value = WorkBk.Range(“S” & i).Value 
     ' Copy Ethnicity 
     TargetSheet.Range("M" & NRow).Value = WorkBk.Range(“F” & i).Value 
     ' Copy Hisp? 
     TargetSheet.Range("N" & NRow).Value = WorkBk.Range(“G” & i).Value 
     ' Copy Diag/LSSP 
     TargetSheet.Range("O" & NRow).Value = WorkBk.Range(“X” & i).Value 

     NRow = NRow + 1 

    End If 

Next i 

End Sub 

Answer 1

Я считаю, что диапазон должен относиться к листу.

Изменить

If WorkBk.Range(“O” & i) = "No" Or WorkBk.Range(“J” & i) = “Initial” Then 

Для

If WorkBk.ActiveSheet.Range("O" & i) = "No" Or WorkBk.ActiveSheet.Range("J" & i) = "Initial" Then 

Answer 2

Я предполагаю, что значение LastRow является < = 8, так что цикл For i = 8 to lastRow просто не выполняется.

Для лучшего способа нахождения последней строки, смотрите здесь:

Error in finding last used cell in VBA

Если его выполнения, большинство заявлений в рамках цикла поднимет ошибку 438, а @MatthewD отмечает в своем ответе , объект Workbook не имеет метода Range, вам нужно будет квалифицировать .Range конкретному объекту Worksheet в книге.

Все высказывания типа ... WorkBk.Range(... должны быть заменены на что-то вроде:

... WorkBk.ActiveSheet.Range(...