Блог

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

 Sub ConditionalCopy()
    Dim dest As Worksheet
    
    Set dest = ActiveWorkbook.Worksheets("VCP Plan")
    
    Dim rng As Range, cell As Range
    Set rng = Range("D:D")
    
    Dim OpenWorkBook As Variant
    OpenWorkBook = Application.GetOpenFilename("Excel Files (*.xlsx* (*.xlsx*),")
    
    If OpenWorkBook <> False Then
        Workbooks.Open (OpenWorkBook)
    End If
    For Each cell In rng
        If cell.Value = "26ASA00015D007" Then
            cell.Offset(0, 3).Copy Destination:=dest.Range("E3")
        End If
    Next cell            
End Sub
  

Из вашего описания и вашего кода неясно, какую книгу / лист вы хотите сравнить и скопировать, и в какую книгу / лист вы хотите скопировать.

Вам нужно быть более конкретным

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

Что-то вроде

 Sub ConditionalCopy()
    Dim wbSource as Workbook
    Dim wsSource as Worksheet
    Dim rSource as Range
    Dim wbDest as Workbook
    Dim wsDest as Worksheet
    Dim rDest as Range

    Set wbDest = ActiveWorkbook ' Are you sure?
    Set wsDest = wbDest.Worksheets("VCP Plan")
    Set rDest = ws.Range("E3")

    Dim OpenWorkBook As Variant
    OpenWorkBook = Application.GetOpenFilename("Excel Files (*.xlsx* (*.xlsx*),")
    
    If OpenWorkBook <> False Then
        Set wbSource = Workbooks.Open(OpenWorkBook) 
    Else
        Exit Sub
    End If

    Set wsSource = wbSource.Worksheets("NameOfSourceSheet")

    Dim cell As Range
    With wsSource
        ' Column D from row 1 to last used row
        Set rSource = .Range(.Cells(1, 4), .Cells(.Rows.Count, 4).End(xlUp))
    End With
    

    For Each cell In rSource
        If cell.Value = "26ASA00015D007" Then
            cell.Offset(0, 3).Copy Destination:=rDest
            ' You probably don't want to overwrite each time, so
            Set rDest = rDest.Offset(1, 0)
        End If
    Next cell            
End Sub