Conditional copy and paste excel vba - excel

Question

I'm trying to copy and paste a certain value from a cell in one sheet matching a range in another workbook. The code runs fine, doesn't give any run-time errors, but will not paste in the range declared in the other workbook. Code below
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

Answer 1

It is unclear from your description and your code which workbook/worksheet you want to compare and copy, and which workbook/worksheet you want to copy to.
You'll need to be more specific
I've made a guess at what you are trying to do. If I've got it wrong, simply adjust the references to suit
Something like
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